Index: /trunk/DOC/chantiers/commit_importants.log
===================================================================
--- /trunk/DOC/chantiers/commit_importants.log	(revision 1402)
+++ /trunk/DOC/chantiers/commit_importants.log	(revision 1403)
@@ -1496,4 +1496,29 @@
 **** commit_v1395 ****
 **********************
-Ehouarn: some cleanup and tydying on the dynamics/physics interface.
+Ehouarn: some cleanup and tidying on the dynamics/physics interface.
 Essentially affects the "iniphysiq" routine in all physics packages.
+
+**********************
+**** commit_v1403 ****
+**********************
+Ehouarn: Reorganizing the physics/dynamics interface.
+
+* makelmdz and makelmdz_fcm scripts adapted to handle the new directory
+  settings
+
+* misc: (replaces what was the "bibio" directory)
+- Should only contain extremely generic (and non physics or
+  dynamics-specific) routines
+- Therefore moved initdynav.F90, initfluxsto.F, inithist.F, writedynav.F90,
+  write_field.F90, writehist.F to "dyn3d_common"
+
+* dynlonlat_phylonlat: (new interface directory)
+- This directory contains routines relevent to physics/dynamics grid
+  interactions, e.g. routines gr_dyn_fi or gr_fi_dyn and calfis
+- Moreover the dynlonlat_phylonlat contains directories "phy***" corresponding
+  to each physics package "phy***" to be used. These subdirectories should
+  only contain specific interfaces (e.g. iniphysiq) or main programs (e.g.
+  newstart)
+
+* phy***/dyn1d: this subdirectory contains the 1D model using physics
+  from phy***
Index: /trunk/LMDZ.COMMON/bld.cfg
===================================================================
--- /trunk/LMDZ.COMMON/bld.cfg	(revision 1402)
+++ /trunk/LMDZ.COMMON/bld.cfg	(revision 1403)
@@ -26,10 +26,12 @@
 src::dyn     %SRC_PATH/%DYN
 src::phys    %SRC_PATH/%PHYS
+src::dyn_phys %DYN_PHYS
+src::dyn_phys_sub %DYN_PHYS_SUB
 src::sisvat  %SISVAT
 src::rrtm    %RRTM
 src::grid    %SRC_PATH/grid
-src::filtrez %SRC_PATH/filtrez
-src::bibio   %SRC_PATH/bibio
-src::dyn3d_common   %SRC_PATH/dyn3d_common
+src::filtrez %FILTRE
+src::bibio   %SRC_PATH/misc
+src::dyn3d_common   %DYN_COMMON
 src::cosp    %COSP
 src::chem    %CHEM
Index: /trunk/LMDZ.COMMON/create_make_gcm
===================================================================
--- /trunk/LMDZ.COMMON/create_make_gcm	(revision 1402)
+++ /trunk/LMDZ.COMMON/create_make_gcm	(revision 1403)
@@ -5,4 +5,6 @@
 #set -xv
 
+# arguments given to create_make_gcm are the directories to scan
+src_dirs=$*
 
 machine=`hostname`
@@ -48,9 +50,10 @@
 fi
 echo "LOCAL_DIR=`echo $localdir`"
-echo 'BIBIO    = $(LIBF)/bibio'
-echo 'DYN3D_COMMON   = $(LIBF)/dyn3d_common'
+echo 'MISC    = $(LIBF)/misc'
+#echo 'DYN3D_COMMON   = $(LIBF)/dyn3d_common'
 echo "FILTRE   = filtre"
 echo "PHYS  = "
 echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'LIBDYN_PHY = $(LIBO)/libdynlmdz_phy$(PHYS).a'
 echo 'DIRMAIN=dyn$(DIM)d$(FLAG_PARA)'
 echo 'RM=rm'
@@ -61,6 +64,7 @@
 echo 'L_DYN      = -ldyn$(DIM)d$(FLAG_PARA) -ldyn3d_common'
 echo 'L_FILTRE   = -l$(FILTRE)'
+echo 'L_DYN_PHY = -ldynlmdz_phy$(PHYS) '
 echo 'L_PHY = -lphy$(PHYS) '
-echo 'L_BIBIO    = -lbibio'
+echo 'L_MISC    = -lmisc'
 echo 'L_ADJNT    ='
 echo 'L_COSP     = -lcosp'
@@ -97,9 +101,9 @@
 echo
 #echo 'main : chimie $(DYN) bibio phys $(OPTION_DEP) '
-echo 'main : $(DYN) bibio phys $(OPTION_DEP) '
+echo 'main : $(DYN) misc phys dyn_phy $(OPTION_DEP) '
 echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '	cd $(LOCAL_DIR); \'
 echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_AERONOMARS) $(L_PHY) $(L_DYN) $(L_DYN3D_COMMON) $(L_BIBIO) $(L_DYN3D_COMMON) $(L_PHY) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_DYN_PHY) $(L_ADJNT) $(L_COSP) $(L_AERONOMARS) $(L_PHY) $(L_DYN) $(L_DYN3D_COMMON) $(L_MISC) $(L_DYN3D_COMMON) $(L_PHY) $(L_DYN_PHY) $(L_DYN) $(L_FILTRE) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 echo
 echo 'phys : $(LIBPHY)'
@@ -108,8 +112,9 @@
 echo 'dyn1d :'
 echo
+echo 'dyn_phy: $(LIBDYN_PHYS)'
 echo
 #echo 'chimie : $(LIBO)/libchimie.a'
 echo
-echo 'bibio : $(LIBO)/libbibio.a'
+echo 'misc : $(LIBO)/libmisc.a'
 echo
 echo 'adjnt : $(LIBO)/libadjnt.a'
@@ -133,13 +138,14 @@
 echo
 cd $libf >/dev/null 2>&1
-for diri in ` ls ` ; do
+
+for diri in $src_dirs ; do
 
    if [ -d $diri ] ; then
-   if [ "`ls $diri/*.F $diri/*/*.F`" != "" ] || [ "`ls $diri/*.[fF]90 $diri/*/*.[fF]90`" != "" ]  ; then 
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.[fF]90`" != "" ]  ; then 
 #      cd $diri >/dev/null 2>&1
       echo
       listlib=""
 # Liste des fichiers .F et .F90 n'etant pas des programmes principaux
-      for fili in `ls $diri/*.[fF] $diri/*/*.[fF]` ; do
+      for fili in `ls $diri/*.[fF]` ; do
          # Check if file is a routine or main program
          # i.e: look for the "program" keword preceeded by leading spaces
@@ -150,5 +156,5 @@
          fi
       done
-      for fili in `ls $diri/*.[fF]90 $diri/*/*.[fF]90` ; do
+      for fili in `ls $diri/*.[fF]90` ; do
          # Check if file is a routine or main program
          # i.e. look for "program" keyword (with possibly some leading spaces)
@@ -163,4 +169,6 @@
       echo $listlib >> $logfile
       echo
+      # topdiri contains main dir name (without trailing "/blabla" for subdirs)
+      topdiri=${diri%/*}
       echo "#======================================================================="
       echo "# Contenu de la bibliotheque correspondant au Directory "$diri
@@ -170,11 +178,11 @@
       do
          fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1`
-         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+         echo '$(LIBO)/lib'$topdiri".a : " '$(LIBO)/lib'$topdiri".a("$fili".o)"
          echo
       done
-      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
-      echo
-      echo
-      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
+      echo '.PRECIOUS	: $(LIBO)/lib'$topdiri'.a'
+      echo
+      echo
+      echo "# Compilation of elements in $diri of library lib"$topdiri".a"
       echo
       for trufile in $listlib ; do
@@ -183,6 +191,6 @@
                  egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
                  egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1
-         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$trufile
-         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+         str1='$(LIBO)/lib'$topdiri'.a('$fili'.o) : $(LIBF)/'$trufile
+         [ "$fili" = "$diri/chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
 
 ##########################################################################
@@ -199,14 +207,14 @@
             strj=`echo $stri | tr [A-Z] [a-z]`
             str2=""
-            for dirinc in filtrez bibio dyn3d_common grid dyn3d phy* $diri $diri/*/ ; do
+            for dirinc in $src_dirs ; do
 # Recherche dans l'ordre hierarchique inverse car seule la derniere
 # ligne est conservee
-               if [ $dirinc = phydev ] ; then
-                   dirstr='$(PHYS)'
-                   libstr='phy$(PHYS)'
-               else
+#               if [ $dirinc = phydev ] ; then
+#                   dirstr='$(PHYS)'
+#                   libstr='phy$(PHYS)'
+#               else
                    dirstr=$dirinc
                    libstr=$dirinc
-               fi
+#               fi
                echo dirinc $dirinc >> $logfile
                if [ -f $dirinc/$stri ] ; then
@@ -238,5 +246,5 @@
          # object from library
          echo '	cd $(LIBO); \'
-         echo '	$(AR) d $(LIBO)/lib'$diri'.a '$fili'.o ; \'
+         echo '	$(AR) d $(LIBO)/lib'$topdiri'.a '$fili'.o ; \'
 	 if [ "$F90" -eq '0' ] ; then
          ## Fixed Form Fortran 77
@@ -252,5 +260,5 @@
 	 fi
          # Put generated object in library
-         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
+         echo '	$(AR) r $(LIBO)/lib'$topdiri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
          echo '	cd $(GCM)'
 	 echo
@@ -303,5 +311,5 @@
                str1='$(LIBF)/'$diri'/'$stri
             else
-               for dirinc in dyn3d grid bibio
+               for dirinc in dyn3d grid misc
                do
                   if [ -f ../$dirinc/$stri ] ; then
Index: unk/LMDZ.COMMON/libf/dyn3d/calfis.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d/calfis.F	(revision 1402)
+++ 	(revision )
@@ -1,958 +1,0 @@
-!
-! $Id: calfis.F 1407 2010-07-07 10:31:52Z fairhead $
-!
-C
-C
-      SUBROUTINE calfis(lafin,
-     $                  jD_cur, jH_cur,
-     $                  pucov,
-     $                  pvcov,
-     $                  pteta,
-     $                  pq,
-     $                  pmasse,
-     $                  pps,
-     $                  pp,
-     $                  ppk,
-     $                  pphis,
-     $                  pphi,
-     $                  pducov,
-     $                  pdvcov,
-     $                  pdteta,
-     $                  pdq,
-     $                  flxw,
-     $                  pdufi,
-     $                  pdvfi,
-     $                  pdhfi,
-     $                  pdqfi,
-     $                  pdpsfi)
-c
-c    Auteur :  P. Le Van, F. Hourdin 
-c   .........
-      USE infotrac, ONLY: nqtot, niadv, tname
-      USE control_mod, ONLY: planet_type, nsplit_phys
-      USE write_field
-      USE cpdet_mod, only: t2tpot,tpot2t
- 
-! used only for zonal averages
-      USE moyzon_mod
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   1. rearrangement des tableaux et transformation
-c      variables dynamiques  >  variables physiques
-c   2. calcul des termes physiques
-c   3. retransformation des tendances physiques en tendances dynamiques
-c
-c   remarques:
-c   ----------
-c
-c    - les vents sont donnes dans la physique par leurs composantes 
-c      naturelles.
-c    - la variable thermodynamique de la physique est une variable
-c      intensive :   T 
-c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
-c    - les deux seules variables dependant de la geometrie necessaires
-c      pour la physique sont la latitude pour le rayonnement et 
-c      l'aire de la maille quand on veut integrer une grandeur 
-c      horizontalement.
-c    - les points de la physique sont les points scalaires de la 
-c      la dynamique; numerotation:
-c          1 pour le pole nord
-c          (jjm-1)*iim pour l'interieur du domaine
-c          ngridmx pour le pole sud
-c      ---> ngridmx=2+(jjm-1)*iim
-c
-c     Input :
-c     -------
-c       pucov           covariant zonal velocity
-c       pvcov           covariant meridional velocity 
-c       pteta           potential temperature
-c       pps             surface pressure
-c       pmasse          masse d'air dans chaque maille
-c       pts             surface temperature  (K)
-c       callrad         clef d'appel au rayonnement
-c
-c    Output :
-c    --------
-c        pdufi          tendency for the natural zonal velocity (ms-1)
-c        pdvfi          tendency for the natural meridional velocity 
-c        pdhfi          tendency for the potential temperature (K/s)
-c        pdtsfi         tendency for the surface temperature
-c
-c        pdtrad         radiative tendencies  \  both input
-c        pfluxrad       radiative fluxes      /  and output
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "logic.h"
-
-      INTEGER ngridmx
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "iniprint.h"
-
-c    Arguments :
-c    -----------
-      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
-      REAL,INTENT(IN) :: jD_cur, jH_cur
-      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
-      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
-      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
-      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
-      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
-      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
-      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
-
-      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
-      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
-      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
-! commentaire SL: pdq ne sert que pour le calcul de pcvgq,
-! qui lui meme ne sert a rien dans la routine telle qu'elle est
-! ecrite, et que j'ai donc commente....
-      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
-      ! NB: pdq is only used to compute pcvgq which is in fact not used...
-
-      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
-      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
-      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
-      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
-
-      ! tendencies (in */s) from the physics
-      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
-      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
-      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
-      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
-      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
-
-
-c    Local variables :
-c    -----------------
-
-      INTEGER i,j,l,ig0,ig,iq,iiq
-      REAL zpsrf(ngridmx)
-      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
-      REAL zphi(ngridmx,llm),zphis(ngridmx)
-
-      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
-      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
-! ADAPTATION GCM POUR CP(T)
-      REAL zteta(ngridmx,llm)
-      REAL zpk(ngridmx,llm)
-
-! RQ SL 13/10/10:
-! Ces calculs ne servent pas. 
-! Si necessaire, decommenter ces variables et les calculs...
-!      REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm)
-!      REAL pcvgt(ngridmx,llm), pcvgq(ngridmx,llm,2)
-
-      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
-      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
-      REAL zdpsrf(ngridmx)
-
-      REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm)
-      REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot)
-      REAL jH_cur_split,zdt_split
-      LOGICAL debut_split,lafin_split
-      INTEGER isplit
-
-      REAL zsin(iim),zcos(iim),z1(iim)
-      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
-      REAL unskap, pksurcp
-      save unskap
-
-      REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
-      
-      REAL SSUM
-
-      LOGICAL,SAVE :: firstcal=.true., debut=.true.
-!      REAL rdayvrai
-
-      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
-
-! For Titan only right now: 
-! to allow for 2D computation of microphys and chemistry
-      LOGICAL,save :: flag_moyzon
-      REAL,allocatable,save :: tmpvar(:,:)
-      REAL,allocatable,save :: tmpvarp1(:,:)
-      REAL,allocatable,save :: tmpvarbar(:)
-      REAL,allocatable,save :: tmpvarbarp1(:)
-      real :: zz1,zz2
-
-c-----------------------------------------------------------------------
-
-c    1. Initialisations :
-c    --------------------
-
-
-      IF ( firstcal )  THEN
-        debut = .TRUE.
-        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         write(lunout,*) 'STOP dans calfis'
-         write(lunout,*)
-     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         write(lunout,*) '  ngridmx  jjm   iim   '
-         write(lunout,*) ngridmx,jjm,iim
-         STOP
-        ENDIF
-
-        unskap   = 1./ kappa
-
-        flag_moyzon = .false.
-        if(moyzon_ch.or.moyzon_mu) then
-         flag_moyzon = .true.
-         allocate(tmpvar(iip1,llm))
-         allocate(tmpvarp1(iip1,llmp1))
-         allocate(tmpvarbar(llm))
-         allocate(tmpvarbarp1(llmp1))
-        endif
-
-        if (flag_moyzon) call moyzon_init(ngridmx,llm,nqtot)
-
-c----------------------------------------------
-c moyennes globales pour le profil de pression
-       if(planet_type.eq."titan".or.planet_type.eq."venus") then
-        ALLOCATE(plevmoy(llm+1))
-        ALLOCATE(playmoy(llm))
-        ALLOCATE(tmoy(llm))
-        ALLOCATE(tetamoy(llm))
-        ALLOCATE(pkmoy(llm))
-        ALLOCATE(phimoy(0:llm))
-        ALLOCATE(zlevmoy(llm+1))
-        ALLOCATE(zlaymoy(llm))
-        plevmoy=0.
-        do l=1,llmp1
-         do i=1,iip1
-          do j=1,jjp1
-            plevmoy(l)=plevmoy(l)+pp(i,j,l)/(iip1*jjp1)
-          enddo
-         enddo
-        enddo
-        tetamoy=0.
-        pkmoy=0.
-        phimoy=0.
-        do i=1,iip1
-         do j=1,jjp1
-            phimoy(0)=phimoy(0)+pphis(i,j)/(iip1*jjp1)
-         enddo
-        enddo
-        do l=1,llm
-         do i=1,iip1
-          do j=1,jjp1
-            tetamoy(l)=tetamoy(l)+pteta(i,j,l)/(iip1*jjp1)
-            pkmoy(l)=pkmoy(l)+ppk(i,j,l)/(iip1*jjp1)
-            phimoy(l)=phimoy(l)+pphi(i,j,l)/(iip1*jjp1)
-          enddo
-         enddo
-        enddo
-        playmoy(:) = preff * (pkmoy(:)/cpp) ** unskap
-        call tpot2t(llm,tetamoy,tmoy,pkmoy)
-c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
-        zlaymoy(:) = g*rad*rad/(g*rad-phimoy(:))-rad
-        zlevmoy(1) = phimoy(0)/g
-        DO l=2,llm
-            zz1=(playmoy(l-1)+plevmoy(l))/(playmoy(l-1)-plevmoy(l))
-            zz2=(plevmoy(l)  +playmoy(l))/(plevmoy(l)  -playmoy(l))
-            zlevmoy(l)=(zz1*zlaymoy(l-1)+zz2*zlaymoy(l))/(zz1+zz2)
-        ENDDO
-        zlevmoy(llmp1)=zlaymoy(llm)+(zlaymoy(llm)-zlevmoy(llm))
-c-------------------
-c + lat index
-        allocate(klat(ngridmx))
-        klat=0
-        klat(1)  = 1
-        ig0  = 2
-        DO j = 2,jjm
-         do i=0,iim-1
-          klat(ig0+i) = j
-         enddo
-         ig0 = ig0+iim
-        ENDDO
-        klat(ngridmx)  = jjp1
-       endif   ! planet_type=titan
-c----------------------------------------------
-      ELSE
-        debut = .FALSE.
-      ENDIF ! of IF (firstcal)
-
-
-c-----------------------------------------------------------------------
-c   40. transformation des variables dynamiques en variables physiques:
-c   ---------------------------------------------------------------
-
-c   41. pressions au sol (en Pascals)
-c   ----------------------------------
-       
-      zpsrf(1) = pps(1,1)
-
-      ig0  = 2
-      DO j = 2,jjm
-         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
-         ig0 = ig0+iim
-      ENDDO
-
-      zpsrf(ngridmx) = pps(1,jjp1)
-
-c   42. pression intercouches et fonction d'Exner:
-
-c   -----------------------------------------------------------------
-c     .... zplev  definis aux (llm +1) interfaces des couches  ....
-c     .... zplay  definis aux (  llm )    milieux des couches  .... 
-c   -----------------------------------------------------------------
-
-c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
-
-! ADAPTATION GCM POUR CP(T)
-      DO l = 1, llm
-        zpk(   1,l ) = ppk(1,1,l)
-        zteta( 1,l ) = pteta(1,1,l)
-        zplev( 1,l ) = pp(1,1,l)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              zpk(   ig0,l ) = ppk(i,j,l)
-              zteta( ig0,l ) = pteta(i,j,l)
-              zplev( ig0,l ) = pp(i,j,l)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        zpk(   ngridmx,l ) = ppk(1,jjp1,l)
-        zteta( ngridmx,l ) = pteta(1,jjp1,l)
-        zplev( ngridmx,l ) = pp(1,jjp1,l)
-      ENDDO
-        zplev( 1,llmp1 ) = pp(1,1,llmp1)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              zplev( ig0,llmp1 ) = pp(i,j,llmp1)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        zplev( ngridmx,llmp1 ) = pp(1,jjp1,llmp1)
-
-      if (flag_moyzon) then
-        tmpvarp1(:,:) = pp(:,1,:)
-        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
-        zplevbar(1,:) = tmpvarbarp1
-        tmpvar(:,:) = ppk(:,1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zpkbar(1,:) = tmpvarbar
-        tmpvar(:,:) = pteta(:,1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        ztetabar(1,:) = tmpvarbar
-        call tpot2t(llm,ztetabar(1,:),ztfibar(1,:),zpkbar(1,:))
-        ig0 = 2
-         do j = 2, jjm
-          tmpvarp1(:,:) = pp(:,j,:)
-          call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
-          zplevbar(ig0,:) = tmpvarbarp1
-          tmpvar(:,:) = ppk(:,j,:)
-          call moyzon(llm,tmpvar,tmpvarbar)
-          zpkbar(ig0,:) = tmpvarbar
-          tmpvar(:,:) = pteta(:,j,:)
-          call moyzon(llm,tmpvar,tmpvarbar)
-          ztetabar(ig0,:) = tmpvarbar
-          call tpot2t(llm,ztetabar(ig0,:),ztfibar(ig0,:),zpkbar(ig0,:))
-          ig0 = ig0+1
-          do i=2,iim
-            zplevbar(ig0,:) = zplevbar(ig0-1,:)
-            zpkbar(ig0,:)   = zpkbar(ig0-1,:)
-            ztetabar(ig0,:) = ztetabar(ig0-1,:)
-            ztfibar(ig0,:)  = ztfibar(ig0-1,:)
-            ig0 = ig0+1
-          enddo
-         enddo
-        tmpvarp1(:,:) = pp(:,jjp1,:)
-        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
-        zplevbar(ngridmx,:) = tmpvarbarp1
-        tmpvar(:,:) = ppk(:,jjp1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zpkbar(ngridmx,:) = tmpvarbar
-        tmpvar(:,:) = pteta(:,jjp1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        ztetabar(ngridmx,:) = tmpvarbar
-        call tpot2t(llm,ztetabar(ngridmx,:),
-     .                  ztfibar(ngridmx,:),zpkbar(ngridmx,:))
-      endif
-
-c   43. temperature naturelle (en K) et pressions milieux couches .
-c   ---------------------------------------------------------------
-
-! ADAPTATION GCM POUR CP(T)
-         call tpot2t(ngridmx*llm,zteta,ztfi,zpk)
-
-      DO l=1,llm
-
-         pksurcp     =  ppk(1,1,l) / cpp
-         zplay(1,l)  =  preff * pksurcp ** unskap
-!         pcvgt(1,l)  =  pdteta(1,1,l) * pksurcp / pmasse(1,1,l)
-         ig0         = 2
-
-         DO j = 2, jjm
-            DO i = 1, iim
-              pksurcp        = ppk(i,j,l) / cpp
-              zplay(ig0,l)   = preff * pksurcp ** unskap
-!              pcvgt(ig0,l)   = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
-              ig0            = ig0 + 1
-            ENDDO
-         ENDDO
-
-         pksurcp       = ppk(1,jjp1,l) / cpp
-         zplay(ig0,l)  = preff * pksurcp ** unskap
-!         pcvgt(ig0,l)  = pdteta(1,jjp1,l) * pksurcp/ pmasse(1,jjp1,l)
-
-      ENDDO
-
-      if (flag_moyzon) then
-        zplaybar(:,:) = preff * (zpkbar(:,:)/cpp)**unskap
-      endif
-
-c   43.bis traceurs (tous intensifs) 
-c   ---------------
-
-      DO iq=1,nqtot
-         DO l=1,llm
-            zqfi(1,l,iq) = pq(1,1,l,iq)
-            ig0          = 2
-            DO j=2,jjm
-               DO i = 1, iim
-                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
-                  ig0             = ig0 + 1
-               ENDDO
-            ENDDO
-            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
-         ENDDO
-      ENDDO  ! boucle sur traceurs
-
-      if (flag_moyzon) then
-       DO iq=1,nqtot
-! RQ: REVOIR A QUOI CA SERT... ET VERIFIER...
-!       iiq=niadv(iq) 
-! en fait, iiq=iq...
-! FIN RQ
-        tmpvar(:,:) = pq(:,1,:,iq)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zqfibar(1,:,iq) = tmpvarbar
-        ig0 = 2
-         do j = 2, jjm
-          tmpvar(:,:) = pq(:,j,:,iq)
-          call moyzon(llm,tmpvar,tmpvarbar)
-          zqfibar(ig0,:,iq) = tmpvarbar
-          ig0 = ig0+1
-          do i=2,iim
-            zqfibar(ig0,:,iq) = zqfibar(ig0-1,:,iq)
-            ig0 = ig0+1
-          enddo
-         enddo
-        tmpvar(:,:) = pq(:,jjp1,:,iq)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zqfibar(ngridmx,:,iq) = tmpvarbar
-       ENDDO ! of DO iq=1,nqtot
-      endif
-
-! DEBUG
-!     do ig0=1,ngridmx
-!       write(*,'(6(e13.5,1x))') zqfibar(ig0,1,10),zqfi(ig0,1,10),
-!    .                         zqfibar(ig0,llm/2,10),zqfi(ig0,llm/2,10), 
-!    .                           zqfibar(ig0,llm,10),zqfi(ig0,llm,10) 
-!     enddo
-!     stop
-
-!-----------------
-! RQ SL 13/10/10:
-! Ces calculs ne servent pas. 
-! Si necessaire, decommenter ces variables et les calculs...
-!
-!   convergence dynamique pour les traceurs "EAU"
-! Earth-specific treatment of first 2 tracers (water)
-!      if (planet_type=="earth") then
-!       DO iq=1,2
-!        DO l=1,llm
-!           pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)
-!           ig0          = 2
-!           DO j=2,jjm
-!              DO i = 1, iim
-!                 pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
-!                 ig0             = ig0 + 1
-!              ENDDO
-!           ENDDO
-!           pcvgq(ig0,l,iq)= pdq(1,jjp1,l,iq) / pmasse(1,jjp1,l)
-!        ENDDO
-!       ENDDO
-!      endif ! of if (planet_type=="earth")
-!----------------
-
-c   Geopotentiel calcule par rapport a la surface locale:
-c   -----------------------------------------------------
-
-      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
-      DO l=1,llm
-         DO ig=1,ngridmx
-           zphi(ig,l)=zphi(ig,l)-zphis(ig)
-         ENDDO
-      ENDDO
-
-      if (flag_moyzon) then
-        tmpvar(:,1) = pphis(:,1)
-        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
-        zphisbar(1) = tmpvarbar(1)
-        tmpvar(:,:) = pphi(:,1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zphibar(1,:) = tmpvarbar
-        ig0 = 2
-         do j = 2, jjm
-          tmpvar(:,1) = pphis(:,j)
-          call moyzon(1,tmpvar(:,1),tmpvarbar(1))
-          zphisbar(ig0) = tmpvarbar(1)
-          tmpvar(:,:) = pphi(:,j,:)
-          call moyzon(llm,tmpvar,tmpvarbar)
-          zphibar(ig0,:) = tmpvarbar
-          ig0 = ig0+1
-          do i=2,iim
-            zphisbar(ig0)  = zphisbar(ig0-1)
-            zphibar(ig0,:) = zphibar(ig0-1,:)
-            ig0 = ig0+1
-          enddo
-         enddo
-        tmpvar(:,1) = pphis(:,jjp1)
-        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
-        zphisbar(ngridmx) = tmpvarbar(1)
-        tmpvar(:,:) = pphi(:,jjp1,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zphibar(ngridmx,:) = tmpvarbar
-      endif
-
-c   ....  Calcul de la vitesse  verticale  ( en Pa*m*s  ou Kg/s )  ....
-c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux 
-c    de masse est calclue dans advtrac.F  
-c      DO l=1,llm
-c        pvervel(1,l)=pw(1,1,l) * g /apoln
-c        ig0=2
-c       DO j=2,jjm
-c           DO i = 1, iim
-c              pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j)
-c              ig0 = ig0 + 1
-c           ENDDO
-c       ENDDO
-c        pvervel(ig0,l)=pw(1,jjp1,l) * g /apols
-c      ENDDO
-
-c
-c   45. champ u:
-c   ------------
-
-      DO 50 l=1,llm
-
-         DO 25 j=2,jjm
-            ig0 = 1+(j-2)*iim
-            zufi(ig0+1,l)= 0.5 * 
-     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
-!            pcvgu(ig0+1,l)= 0.5 * 
-!     $      ( pducov(iim,j,l)/cu(iim,j) + pducov(1,j,l)/cu(1,j) )
-            DO 10 i=2,iim
-               zufi(ig0+i,l)= 0.5 *
-     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
-!               pcvgu(ig0+i,l)= 0.5 *
-!     $         ( pducov(i-1,j,l)/cu(i-1,j) + pducov(i,j,l)/cu(i,j) )
-10         CONTINUE
-25      CONTINUE
-
-50    CONTINUE
-
-
-c   46.champ v:
-c   -----------
-
-      DO l=1,llm
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               zvfi(ig0+i,l)= 0.5 *
-     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
-c               pcvgv(ig0+i,l)= 0.5 *
-c     $         ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) )
-            ENDDO
-         ENDDO
-      ENDDO
-
-
-c   47. champs de vents aux pole nord   
-c   ------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
-         ENDDO
-
-         DO i=1,iim
-            zcos(i)   = COS(rlonv(i))*z1(i)
-            zcosbis(i)= COS(rlonv(i))*z1bis(i)
-            zsin(i)   = SIN(rlonv(i))*z1(i)
-            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
-         ENDDO
-
-         zufi(1,l)  = SSUM(iim,zcos,1)/pi
-!         pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
-         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
-!         pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
-
-      ENDDO
-
-
-c   48. champs de vents aux pole sud:
-c   ---------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
-         ENDDO
-
-         DO i=1,iim
-            zcos(i)    = COS(rlonv(i))*z1(i)
-            zcosbis(i) = COS(rlonv(i))*z1bis(i)
-            zsin(i)    = SIN(rlonv(i))*z1(i)
-            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
-         ENDDO
-
-         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
-!         pcvgu(ngridmx,l) = SSUM(iim,zcosbis,1)/pi
-         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
-!         pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi
-
-      ENDDO
-c
-c On change de grille, dynamique vers physiq, pour le flux de masse verticale
-      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi)
-
-c-----------------------------------------------------------------------
-c   Appel de la physique:
-c   ---------------------
-
-! Appel de la physique: pose probleme quand on tourne 
-! SANS physique, car physiq.F est dans le repertoire phy[]... 
-! Il faut une cle CPP_PHYS
-
-! Le fait que les arguments de physiq soient differents selon les planetes 
-! ne pose pas de probleme a priori.
-
-!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
-      zdt_split=dtphys/nsplit_phys
-      zdufic(:,:)=0.
-      zdvfic(:,:)=0.
-      zdtfic(:,:)=0.
-      zdqfic(:,:,:)=0.
-
-#ifdef CPP_PHYS
-
-      do isplit=1,nsplit_phys
-
-         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
-         debut_split=debut.and.isplit==1
-         lafin_split=lafin.and.isplit==nsplit_phys
-
-      if (planet_type.eq."earth") then
-         CALL physiq (ngridmx,
-     .             llm,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev,
-     .             zplay,
-     .             zphi,
-     .             zphis,
-     .             presnivs,
-     .             zufi,
-     .             zvfi,
-     .             ztfi,
-     .             zqfi,
-     .             flxwfi,
-     .             zdufi,
-     .             zdvfi,
-     .             zdtfi,
-     .             zdqfi,
-     .             zdpsrf,
-     .             pducov)
-
-      else if ( planet_type=="generic" ) then
-
-         CALL physiq (ngridmx,     !! ngrid
-     .             llm,            !! nlayer
-     .             nqtot,          !! nq
-     .             tname,          !! tracer names from dynamical core (given in infotrac)
-     .             debut_split,    !! firstcall 
-     .             lafin_split,    !! lastcall
-     .             jD_cur,         !! pday. see leapfrog
-     .             jH_cur_split,   !! ptime "fraction of day"
-     .             zdt_split,      !! ptimestep
-     .             zplev,          !! pplev
-     .             zplay,          !! pplay
-     .             zphi,           !! pphi
-     .             zufi,           !! pu
-     .             zvfi,           !! pv
-     .             ztfi,           !! pt
-     .             zqfi,           !! pq
-     .             flxwfi,         !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
-     .             zdufi,          !! pdu
-     .             zdvfi,          !! pdv
-     .             zdtfi,          !! pdt
-     .             zdqfi,          !! pdq
-     .             zdpsrf,         !! pdpsrf
-     .             tracerdyn)      !! tracerdyn <-- utilite ???
-
-      else if ( planet_type=="mars" ) then
-
-        CALL physiq (ngridmx,    ! ngrid
-     .             llm,          ! nlayer
-     .             nqtot,        ! nq
-     .             debut_split,  ! firstcall
-     .             lafin_split,  ! lastcall
-     .             jD_cur,       ! pday
-     .             jH_cur_split, ! ptime
-     .             zdt_split,    ! ptimestep
-     .             zplev,        ! pplev
-     .             zplay,        ! pplay
-     .             zphi,         ! pphi
-     .             zufi,         ! pu
-     .             zvfi,         ! pv
-     .             ztfi,         ! pt
-     .             zqfi,         ! pq
-     .             flxwfi,       ! pw
-     .             zdufi,        ! pdu
-     .             zdvfi,        ! pdv
-     .             zdtfi,        ! pdt
-     .             zdqfi,        ! pdq
-     .             zdpsrf,       ! pdpsrf
-     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
-
-      else if ((planet_type=="titan").or.(planet_type=="venus")) then
-
-         CALL physiq (ngridmx,
-     .             llm,
-     .             nqtot,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev,
-     .             zplay,
-     .             zpk,
-     .             zphi,
-     .             zphis,
-     .             presnivs,
-     .             zufi,
-     .             zvfi,
-     .             ztfi,
-     .             zqfi,
-     .             flxwfi,
-     .             zdufi,
-     .             zdvfi,
-     .             zdtfi,
-     .             zdqfi,
-     .             zdpsrf)
-
-      else ! unknown "planet_type"
-
-        write(lunout,*) "calfis_p: error, unknown planet_type: ",
-     &                  trim(planet_type)
-        stop
-
-      endif ! planet_type
-
-         zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
-         zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split
-         ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split
-         zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split
-
-         zdufic(:,:)=zdufic(:,:)+zdufi(:,:)
-         zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:)
-         zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:)
-         zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
-
-      enddo ! of do isplit=1,nsplit_phys
-
-! ATTENTION...
-      if (flag_moyzon.and.(nsplit_phys.ne.1)) then
-       print*,"WARNING ! flag_moyzon + nsplit_phys"
-       print*,"zqfibar n'est pas implemente au cours des iterations"
-       print*,"Donc a revoir..."
-       stop
-      endif
-
-#endif
-! #endif of #ifdef CPP_PHYS
-
-      zdufi(:,:)=zdufic(:,:)/nsplit_phys
-      zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
-      zdtfi(:,:)=zdtfic(:,:)/nsplit_phys
-      zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
-
-
-500   CONTINUE
-
-c-----------------------------------------------------------------------
-c   transformation des tendances physiques en tendances dynamiques:
-c   ---------------------------------------------------------------
-
-c  tendance sur la pression :
-c  -----------------------------------
-
-      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
-c
-c   62. enthalpie potentielle
-c   ---------------------
-
-! ADAPTATION GCM POUR CP(T)
-      call t2tpot(ngridmx*llm,ztfi,zteta,zpk)
-
-         DO i=1,iip1
-      pdhfi(i,1,:) = (zteta(1,:) - pteta(i,1,:))/dtphys
-      pdhfi(i,jjp1,:) = (zteta(ngridmx,:) - pteta(i,jjp1,:))/dtphys
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-      pdhfi(i,j,:) = (zteta(ig0+i,:) - pteta(i,j,:))/dtphys
-            ENDDO
-               pdhfi(iip1,j,:) =  pdhfi(1,j,:)
-         ENDDO
-
-
-c   62. humidite specifique
-c   ---------------------
-! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
-!      DO iq=1,nqtot
-!         DO l=1,llm
-!            DO i=1,iip1
-!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
-!               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
-!            ENDDO
-!            DO j=2,jjm
-!               ig0=1+(j-2)*iim
-!               DO i=1,iim
-!                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
-!               ENDDO
-!               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
-!            ENDDO
-!         ENDDO
-!      ENDDO
-
-c   63. traceurs (tous en intensifs)
-c   ------------
-C     initialisation des tendances
-      pdqfi(:,:,:,:)=0.
-C
-       DO iq=1,nqtot
-         iiq=niadv(iq)
-         DO l=1,llm
-            DO i=1,iip1
-               pdqfi(i,1,l,iiq)    = zdqfi(1,l,iq)
-               pdqfi(i,jjp1,l,iiq) = zdqfi(ngridmx,l,iq)
-            ENDDO
-            DO j=2,jjm
-               ig0=1+(j-2)*iim
-               DO i=1,iim
-                  pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)
-               ENDDO
-               pdqfi(iip1,j,l,iiq) = pdqfi(1,j,l,iq)
-            ENDDO
-         ENDDO
-       ENDDO
-
-c   65. champ u:
-c   ------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-            pdufi(i,1,l)    = 0.
-            pdufi(i,jjp1,l) = 0.
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim-1
-               pdufi(i,j,l)=
-     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
-            ENDDO
-            pdufi(iim,j,l)=
-     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
-            pdufi(iip1,j,l)=pdufi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   67. champ v:
-c   ------------
-
-      DO l=1,llm
-
-         DO j=2,jjm-1
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdvfi(i,j,l)=
-     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
-            ENDDO
-            pdvfi(iip1,j,l) = pdvfi(1,j,l)
-         ENDDO
-      ENDDO
-
-
-c   68. champ v pres des poles:
-c   ---------------------------
-c      v = U * cos(long) + V * SIN(long)
-
-      DO l=1,llm
-
-         DO i=1,iim
-            pdvfi(i,1,l)=
-     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
-            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
-     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
-            pdvfi(i,1,l)=
-     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
-            pdvfi(i,jjm,l)=
-     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
-          ENDDO
-
-         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
-         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-
-700   CONTINUE
- 
-      firstcal = .FALSE.
-
-      RETURN
-      END
Index: /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1402)
+++ /trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F	(revision 1403)
@@ -170,5 +170,5 @@
       logical ok_sync
       parameter (ok_sync = .true.) 
-      logical physic
+      logical physics
 
       data callinigrads/.true./
@@ -251,6 +251,6 @@
 
       itau = 0
-      physic=.true.
-      if (iflag_phys==0.or.iflag_phys==2) physic=.false.
+      physics=.true.
+      if (iflag_phys==0.or.iflag_phys==2) physics=.false.
 
 c      iday = day_ini+itau/day_step
@@ -362,5 +362,5 @@
      s        apdiss = .TRUE.
          IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
-     s          .and. physic                        ) apphys = .TRUE.
+     s          .and. physics                        ) apphys = .TRUE.
       ELSE
       ! Leapfrog/Matsuno time stepping 
@@ -368,5 +368,5 @@
          IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward )
      s        apdiss = .TRUE.
-         IF( MOD(itau+1,iphysiq).EQ.0.AND.physic       ) apphys=.TRUE.
+         IF( MOD(itau+1,iphysiq).EQ.0.AND.physics       ) apphys=.TRUE.
       END IF
 
Index: /trunk/LMDZ.COMMON/libf/dyn3d/logic.h
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d/logic.h	(revision 1402)
+++ /trunk/LMDZ.COMMON/libf/dyn3d/logic.h	(revision 1403)
@@ -12,5 +12,5 @@
      &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
      &  ,ok_limit,ok_etat0,hybrid                                       &
-     &  ,moyzon_mu,moyzon_ch
+     &  ,moyzon_mu,moyzon_ch,grireg,physic
 
       COMMON/logici/ iflag_phys,iflag_trac
@@ -26,3 +26,7 @@
 
       integer iflag_phys,iflag_trac
+
+! stuff for compatibility with Mars/Generic old dyn cores. To be cleaned!
+      logical grireg,physic
+
 !-----------------------------------------------------------------------
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/control_mod.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/control_mod.F90	(revision 1402)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/control_mod.F90	(revision 1403)
@@ -51,3 +51,8 @@
   real,save :: timestart ! (Mars) time start for run in "start.nc"
 
+  ! stuff for compatibility with Mars/Generic old dyn cores. To be cleaned!
+  integer,save :: idissip ! (Mars/old dyn) dissipation freq.
+  real,save :: nday_r ! (Mars/old dyn) number of days to run (possibly including a fraction of day)
+
+
 END MODULE
Index: unk/LMDZ.COMMON/libf/dyn3d_common/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/gr_dyn_fi.F	(revision 1402)
+++ 	(revision )
@@ -1,38 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: unk/LMDZ.COMMON/libf/dyn3d_common/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/gr_fi_dyn.F	(revision 1402)
+++ 	(revision )
@@ -1,40 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1402)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/infotrac.F90	(revision 1403)
@@ -444,3 +444,130 @@
   END SUBROUTINE infotrac_init
 
+! Ehouarn: routine iniadvtrac => from Mars/generic; does essentially the
+!          same job as infotrac_init. To clean up and merge at some point...
+      subroutine iniadvtrac(nq,numvanle)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! routine which initializes tracer names and advection schemes
+! reads these infos from file 'traceur.def' but uses default values
+! if that file is not found.
+! Ehouarn Millour. Oct. 2008  (made this LMDZ4-like) for future compatibility 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      IMPLICIT NONE
+
+!#include "dimensions.h"
+!#include "advtrac.h"
+!#include "control.h"
+
+! routine arguments:
+      INTEGER,INTENT(out) :: nq ! number of tracers
+      INTEGER,INTENT(out) :: numvanle
+
+! local variables:
+      LOGICAL :: first
+      INTEGER :: iq
+      INTEGER :: ierr
+      CHARACTER(len=3) :: qname
+
+! Look for file traceur.def
+      OPEN(90,file='traceur.def',form='formatted',status='old', &
+              iostat=ierr)
+      IF (ierr.eq.0) THEN
+        write(*,*) "iniadvtrac: Reading file traceur.def"
+        ! read number of tracers:
+        read(90,*,iostat=ierr) nq
+        if (ierr.ne.0) then
+          write(*,*) "iniadvtrac: error reading number of tracers"
+          write(*,*) "   (first line of traceur.def) "
+          stop
+        endif
+        
+        ! allocate arrays:
+        allocate(iadv(nq))
+        allocate(tname(nq))
+        
+        ! initialize advection schemes to Van-Leer for all tracers
+        do iq=1,nq
+          iadv(iq)=3 ! Van-Leer
+        enddo
+        
+        do iq=1,nq
+        ! minimal version, just read in the tracer names, 1 per line
+          read(90,*,iostat=ierr) tname(iq)
+          if (ierr.ne.0) then
+            write(*,*) 'iniadvtrac: error reading tracer names...'
+            stop
+          endif
+        enddo !of do iq=1,nq
+        close(90) ! done reading tracer names, close file
+      ENDIF ! of IF (ierr.eq.0)
+
+!  ....  Choix  des shemas d'advection pour l'eau et les traceurs  ...
+!  ...................................................................
+!
+!     iadv = 1    shema  transport type "humidite specifique LMD"  
+!     iadv = 2    shema   amont
+!     iadv = 3    shema  Van-leer
+!     iadv = 4    schema  Van-leer + humidite specifique
+!                        Modif F.Codron
+! 
+!
+      DO  iq = 1, nq-1
+       IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'&
+       ,' pour le traceur no ', iq
+       IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema  amont',' pour le'  &
+       ,' traceur no ', iq
+       IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour' &
+       ,'le traceur no ', iq
+
+       IF( iadv(iq).EQ.4 )  THEN
+         PRINT *,' Le shema  Van-Leer + humidite specifique ',          &
+       ' est  uniquement pour la vapeur d eau .'
+         PRINT *,' Corriger iadv( ',iq, ')  et repasser ! '
+         CALL ABORT
+       ENDIF
+
+       IF( iadv(iq).LE.0.OR.iadv(iq).GT.4 )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqtot).Corriger et '    &
+       ,' repasser car  iadv(iq) = ', iadv(iq)
+         CALL ABORT
+       ENDIF
+      ENDDO
+
+       IF( iadv(nq).EQ.1 ) PRINT *,' Choix du shema humidite '          &
+       ,'specifique pour la vapeur d''eau'
+       IF( iadv(nq).EQ.2 ) PRINT *,' Choix du shema  amont',' pour la'  &
+       ,' vapeur d''eau '
+       IF( iadv(nq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer '         &
+       ,' pour la vapeur d''eau'
+       IF( iadv(nq).EQ.4 ) PRINT *,' Choix du shema  Van-Leer + '       &
+       ,' humidite specifique pour la vapeur d''eau'
+!
+       IF( (iadv(nq).LE.0).OR.(iadv(nq).GT.4) )   THEN
+        PRINT *,' Erreur dans le choix de iadv (nqtot).Corriger et '    &
+       ,' repasser car  iadv(nqtot) = ', iadv(nqtot)
+         CALL ABORT
+       ENDIF
+
+      first = .TRUE.
+      numvanle = nq + 1
+      DO  iq = 1, nq
+        IF(((iadv(iq).EQ.3).OR.(iadv(iq).EQ.4)).AND.first ) THEN
+          numvanle = iq
+          first    = .FALSE. 
+        ENDIF
+      ENDDO
+!
+      DO  iq = 1, nq
+
+      IF( (iadv(iq).NE.3.AND.iadv(iq).NE.4).AND.iq.GT.numvanle )  THEN
+          PRINT *,' Il y a discontinuite dans le choix du shema de ',   &
+          'Van-leer pour les traceurs . Corriger et repasser . '
+           CALL ABORT
+      ENDIF
+
+      ENDDO
+!
+      end subroutine iniadvtrac
+
+
 END MODULE infotrac
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/initdynav.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/initdynav.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/initdynav.F90	(revision 1403)
@@ -0,0 +1,194 @@
+! $Id: initdynav.F90 1611 2012-01-25 14:31:54Z lguez $
+
+subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
+
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#endif
+  USE infotrac, ONLY : nqtot, ttext
+  use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, &
+       dynhistave_file,dynhistvave_file,dynhistuave_file
+  implicit none
+
+
+  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
+
+  !   Appels succesifs des routines: histbeg
+  !                                  histhori
+  !                                  histver
+  !                                  histdef
+  !                                  histend
+
+  !   Entree:
+
+  !      infile: nom du fichier histoire a creer
+  !      day0,anne0: date de reference
+  !      tstep : frequence d'ecriture
+  !      t_ops: frequence de l'operation pour IOIPSL
+  !      t_wrt: frequence d'ecriture sur le fichier
+
+
+  !   L. Fairhead, LMD, 03/99
+
+  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 "iniprint.h"
+
+  !   Arguments
+
+  integer day0, anne0
+  real tstep, t_ops, t_wrt
+
+#ifdef CPP_IOIPSL
+  ! This routine needs IOIPSL to work
+  !   Variables locales
+
+  integer tau0
+  real zjulian
+  integer iq
+  real rlong(iip1,jjp1), rlat(iip1,jjp1)
+  integer uhoriid, vhoriid, thoriid, zvertiid
+  integer ii,jj
+  integer zan, dayref
+
+  !--------------------------------------------------------------------
+
+  !  Initialisations
+
+  pi = 4. * atan (1.)
+
+  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+
+
+  zan = anne0
+  dayref = day0
+  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
+  tau0 = itau_dyn
+
+  do jj = 1, jjp1
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonv(ii) * 180. / pi
+        rlat(ii,jj)  = rlatu(jj) * 180. / pi
+     enddo
+  enddo
+
+  ! Creation de 3 fichiers pour les differentes grilles horizontales
+  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
+  ! Grille Scalaire       
+  call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
+       1, iip1, 1, jjp1, &
+       tau0, zjulian, tstep, thoriid,histaveid)
+
+  ! Creation du fichier histoire pour les grilles en V et U (oblige
+  ! pour l'instant, IOIPSL ne permet pas de grilles avec des nombres
+  ! de point differents dans  un meme fichier)
+  ! Grille V
+  do jj = 1, jjm
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonv(ii) * 180. / pi
+        rlat(ii,jj) = rlatv(jj) * 180. / pi
+     enddo
+  enddo
+
+  call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), &
+       1, iip1, 1, jjm, &
+       tau0, zjulian, tstep, vhoriid,histvaveid)
+  ! Grille U
+  do jj = 1, jjp1
+     do ii = 1, iip1
+        rlong(ii,jj) = rlonu(ii) * 180. / pi
+        rlat(ii,jj) = rlatu(jj) * 180. / pi
+     enddo
+  enddo
+
+  call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), &
+       1, iip1, 1, jjp1, &
+       tau0, zjulian, tstep, uhoriid,histuaveid)
+
+  !  Appel a histvert pour la grille verticale
+
+  call histvert(histaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+  call histvert(histuaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+  call histvert(histvaveid,'presnivs','Niveaux Pression approximatifs','mb', &
+       llm, presnivs/100., zvertiid,'down')
+
+  !  Appels a histdef pour la definition des variables a sauvegarder
+
+  !  Vents U
+
+  call histdef(histuaveid, 'u', 'vent u moyen ', &
+       'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Vents V
+
+  call histdef(histvaveid, 'v', 'vent v moyen', &
+       'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+
+  !  Temperature
+
+  call histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Temperature potentielle
+
+  call histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Geopotentiel
+
+  call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Traceurs
+
+  !        DO iq=1,nqtot
+  !          call histdef(histaveid, ttext(iq), ttext(iq), '-', &
+  !                  iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+  !                  32, 'ave(X)', t_ops, t_wrt)
+  !        enddo
+
+  !  Masse
+
+  call histdef(histaveid, 'masse', 'masse', 'kg', &
+       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Pression au sol
+
+  call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
+       iip1, jjp1, thoriid, 1, 1, 1, -99, &
+       32, 'ave(X)', t_ops, t_wrt)
+
+  !  Geopotentiel au sol
+
+  !      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-', &
+  !                  iip1, jjp1, thoriid, 1, 1, 1, -99, &
+  !                  32, 'ave(X)', t_ops, t_wrt)
+
+  call histend(histaveid)
+  call histend(histuaveid)
+  call histend(histvaveid)
+#else
+  write(lunout,*)"initdynav: Warning this routine should not be", &
+       " used without ioipsl"
+#endif
+  ! of #ifdef CPP_IOIPSL
+
+end subroutine initdynav
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/initfluxsto.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/initfluxsto.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/initfluxsto.F	(revision 1403)
@@ -0,0 +1,233 @@
+!
+! $Id: initfluxsto.F 1279 2009-12-10 09:02:56Z fairhead $
+!
+      subroutine initfluxsto
+     .  (infile,tstep,t_ops,t_wrt,
+     .                    fileid,filevid,filedid)
+
+#ifdef CPP_IOIPSL
+       USE IOIPSL
+#endif
+      implicit none
+
+C
+C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+C   au format IOIPSL
+C
+C   Appels succesifs des routines: histbeg
+C                                  histhori
+C                                  histver
+C                                  histdef
+C                                  histend
+C
+C   Entree:
+C
+C      infile: nom du fichier histoire a creer
+C      day0,anne0: date de reference
+C      tstep: duree du pas de temps en seconde
+C      t_ops: frequence de l'operation pour IOIPSL
+C      t_wrt: frequence d'ecriture sur le fichier
+C
+C   Sortie:
+C      fileid: ID du fichier netcdf cree
+C      filevid:ID du fichier netcdf pour la grille v
+C
+C   L. Fairhead, LMD, 03/99
+C
+C =====================================================================
+C
+C   Declarations
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "iniprint.h"
+
+C   Arguments
+C
+      character*(*) infile
+      real tstep, t_ops, t_wrt
+      integer fileid, filevid,filedid
+
+#ifdef CPP_IOIPSL
+! This routine needs IOIPSL to work
+C   Variables locales
+C
+      real nivd(1)
+      integer tau0
+      real zjulian
+      character*3 str
+      character*10 ctrac
+      integer iq
+      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
+      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
+      integer ii,jj
+      integer zan, idayref
+      logical ok_sync
+C
+C  Initialisations
+C
+      pi = 4. * atan (1.)
+      str='q  '
+      ctrac = 'traceur   '
+      ok_sync = .true.
+C
+C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+C         
+
+      zan = annee_ref
+      idayref = day_ref
+      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
+      tau0 = itau_dyn
+	
+	do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonu(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+ 
+      call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
+     .             1, iip1, 1, jjp1,
+     .             tau0, zjulian, tstep, uhoriid, fileid)
+C
+C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
+C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
+C  un meme fichier)
+
+
+      do jj = 1, jjm
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatv(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
+     .             1, iip1, 1, jjm,
+     .             tau0, zjulian, tstep, vhoriid, filevid)
+	
+	rl(1,1) = 1.	
+      call histbeg('defstoke.nc', 1, rl, 1, rl,
+     .             1, 1, 1, 1,
+     .             tau0, zjulian, tstep, dhoriid, filedid)
+
+C
+C  Appel a histhori pour rajouter les autres grilles horizontales
+C
+      do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
+     .              'Grille points scalaires', thoriid)
+	
+C
+C  Appel a histvert pour la grille verticale
+C
+      call histvert(fileid, 'sig_s', 'Niveaux sigma',
+     . 'sigma_level',
+     .              llm, nivsigs, zvertiid)
+C Pour le fichier V
+      call histvert(filevid, 'sig_s', 'Niveaux sigma',
+     .  'sigma_level',
+     .              llm, nivsigs, zvertiid)
+c pour le fichier def
+      nivd(1) = 1
+      call histvert(filedid, 'sig_s', 'Niveaux sigma',
+     .  'sigma_level',
+     .              1, nivd, dvertiid)
+
+C
+C  Appels a histdef pour la definition des variables a sauvegarder
+	
+	CALL histdef(fileid, "phis", "Surface geop. height", "-",
+     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+
+         CALL histdef(fileid, "aire", "Grid area", "-",
+     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+	
+	CALL histdef(filedid, "dtvr", "tps dyn", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+        
+         CALL histdef(filedid, "istdyn", "tps stock", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+         
+         CALL histdef(filedid, "istphy", "tps stock phy", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+
+
+C
+C Masse 
+C
+      call histdef(fileid, 'masse', 'Masse', 'kg',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Pbaru 
+C
+      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
+     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C  Pbarv 
+C
+      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
+     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  w 
+C
+      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C  Temperature potentielle
+C
+      call histdef(fileid, 'teta', 'temperature potentielle', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+
+C
+C Geopotentiel 
+C
+      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Fin
+C
+      call histend(fileid)
+      call histend(filevid)
+      call histend(filedid)
+      if (ok_sync) then
+        call histsync(fileid)
+        call histsync(filevid)
+        call histsync(filedid)
+      endif
+	
+#else
+! tell the user this routine should be run with ioipsl
+      write(lunout,*)"initfluxsto: Warning this routine should not be",
+     &               " used without ioipsl"
+#endif
+! of #ifdef CPP_IOIPSL
+      return
+      end
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/inithist.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/inithist.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/inithist.F	(revision 1403)
@@ -0,0 +1,197 @@
+!
+! $Id: inithist.F 1403 2010-07-01 09:02:53Z fairhead $
+!
+      subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
+
+#ifdef CPP_IOIPSL
+       USE IOIPSL
+#endif
+       USE infotrac, ONLY : nqtot, ttext
+       use com_io_dyn_mod, only : histid,histvid,histuid,               &
+     &                        dynhist_file,dynhistv_file,dynhistu_file
+
+      implicit none
+
+C
+C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+C   au format IOIPSL
+C
+C   Appels succesifs des routines: histbeg
+C                                  histhori
+C                                  histver
+C                                  histdef
+C                                  histend
+C
+C   Entree:
+C
+C      infile: nom du fichier histoire a creer
+C      day0,anne0: date de reference
+C      tstep: duree du pas de temps en seconde
+C      t_ops: frequence de l'operation pour IOIPSL
+C      t_wrt: frequence d'ecriture sur le fichier
+C      nq: nombre de traceurs
+C
+C
+C   L. Fairhead, LMD, 03/99
+C
+C =====================================================================
+C
+C   Declarations
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "iniprint.h"
+
+C   Arguments
+C
+      integer day0, anne0
+      real tstep, t_ops, t_wrt
+
+#ifdef CPP_IOIPSL
+! This routine needs IOIPSL to work
+C   Variables locales
+C
+      integer tau0
+      real zjulian
+      integer iq
+      real rlong(iip1,jjp1), rlat(iip1,jjp1)
+      integer uhoriid, vhoriid, thoriid, zvertiid
+      integer ii,jj
+      integer zan, dayref
+C
+C  Initialisations
+C
+      pi = 4. * atan (1.)
+C
+C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+C         
+
+      zan = anne0
+      dayref = day0
+      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
+      tau0 = itau_dyn
+      
+! -------------------------------------------------------------
+! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
+! -------------------------------------------------------------
+!Grille U      
+      do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonu(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+       
+      call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
+     .             1, iip1, 1, jjp1,
+     .             tau0, zjulian, tstep, uhoriid, histuid)
+
+! Grille V
+      do jj = 1, jjm
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatv(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
+     .             1, iip1, 1, jjm,
+     .             tau0, zjulian, tstep, vhoriid, histvid)
+
+!Grille Scalaire
+      do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
+     .             1, iip1, 1, jjp1,
+     .             tau0, zjulian, tstep, thoriid, histid)
+! -------------------------------------------------------------
+C  Appel a histvert pour la grille verticale
+! -------------------------------------------------------------
+      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
+      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
+      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
+C
+! -------------------------------------------------------------
+C  Appels a histdef pour la definition des variables a sauvegarder
+! -------------------------------------------------------------
+C
+C  Vents U
+C
+      call histdef(histuid, 'u', 'vent u', 'm/s',
+     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Vents V
+C
+      call histdef(histvid, 'v', 'vent v', 'm/s',
+     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C  Temperature potentielle
+C
+      call histdef(histid, 'teta', 'temperature potentielle', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Geopotentiel
+C
+      call histdef(histid, 'phi', 'geopotentiel', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Traceurs
+C
+!
+!        DO iq=1,nqtot
+!          call histdef(histid, ttext(iq),  ttext(iq), '-',
+!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+!     .             32, 'inst(X)', t_ops, t_wrt)
+!        enddo
+!C
+C  Masse
+C
+      call histdef(histid, 'masse', 'masse', 'kg',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Pression au sol
+C
+      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
+     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Geopotentiel au sol
+!C
+!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
+!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
+!     .             32, 'inst(X)', t_ops, t_wrt)
+!C
+C  Fin
+C
+      call histend(histid)
+      call histend(histuid)
+      call histend(histvid)
+#else
+! tell the user this routine should be run with ioipsl
+      write(lunout,*)"inithist: Warning this routine should not be",
+     &               " used without ioipsl"
+#endif
+! of #ifdef CPP_IOIPSL
+      return
+      end
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/write_field.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/write_field.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/write_field.F90	(revision 1403)
@@ -0,0 +1,326 @@
+!
+! $Id: write_field.F90 1279 2009-12-10 09:02:56Z fairhead $
+!
+module write_field
+implicit none
+
+  integer, parameter :: MaxWriteField = 100
+  integer, dimension(MaxWriteField),save :: FieldId
+  integer, dimension(MaxWriteField),save :: FieldVarId
+  integer, dimension(MaxWriteField),save :: FieldIndex
+  character(len=255), dimension(MaxWriteField) ::  FieldName 
+   
+  integer,save :: NbField = 0
+  
+  interface WriteField
+    module procedure WriteField3d,WriteField2d,WriteField1d
+  end interface WriteField
+  contains
+  
+    function GetFieldIndex(name)
+    implicit none
+      integer          :: GetFieldindex
+      character(len=*) :: name
+    
+      character(len=255) :: TrueName
+      integer            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      do i=1,NbField
+        if (TrueName==FieldName(i)) then
+          GetFieldIndex=i
+          exit
+        endif
+      enddo
+    end function GetFieldIndex
+ 
+    subroutine WriteField3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3))  
+  
+    end subroutine WriteField3d
+    
+    subroutine WriteField2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),Dim(2),1)  
+  
+    end subroutine WriteField2d
+    
+    subroutine WriteField1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),1,1)  
+  
+    end subroutine WriteField1d
+        
+    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
+    implicit none
+    include 'netcdf.inc'
+      character(len=*) :: name
+      integer :: dimx,dimy,dimz
+      real,dimension(dimx,dimy,dimz) :: Field
+      integer,dimension(dimx*dimy*dimz) :: ndex
+      integer :: status
+      integer :: index
+      integer :: start(4)
+      integer :: count(4)
+      
+           
+      Index=GetFieldIndex(name)
+      if (Index==-1) then
+        call CreateNewField(name,dimx,dimy,dimz)
+	Index=GetFieldIndex(name)
+      else
+        FieldIndex(Index)=FieldIndex(Index)+1.
+      endif
+      
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=FieldIndex(Index)
+
+      count(1)=dimx
+      count(2)=dimy
+      count(3)=dimz
+      count(4)=1
+
+      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
+      status = NF_SYNC(FieldId(Index))
+      
+    end subroutine WriteField_gen
+       
+    subroutine CreateNewField(name,dimx,dimy,dimz)
+    implicit none
+    include 'netcdf.inc'  
+      character(len=*) :: name
+      integer :: dimx,dimy,dimz
+      integer :: TabDim(4)
+      integer :: status
+      
+      
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      
+      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
+      status = NF_DEF_DIM(FieldId(NbField),'X',dimx,TabDim(1))
+      status = NF_DEF_DIM(FieldId(NbField),'Y',dimy,TabDim(2))
+      status = NF_DEF_DIM(FieldId(NbField),'Z',dimz,TabDim(3))
+      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(4))
+      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,4,TabDim,FieldVarId(NbField))
+      status = NF_ENDDEF(FieldId(NbField))
+
+    end subroutine CreateNewField
+    
+    
+    
+  subroutine write_field1D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=1
+    character(len=*)   :: name
+    real, dimension(:) :: Field
+    real, dimension(:),allocatable :: New_Field
+    character(len=20) :: str
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos
+    character(len=255) :: form
+    character(len=255) :: MaxLen
+    
+    
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'",//)')
+    Dim=shape(Field)
+    MaxLen=int2str(len(trim(int2str(Dim(1)))))
+    ColumnSize=20+6+3+len(trim(int2str(Dim(1))))
+    Nb=0
+    Pos=2
+    do i=1,Dim(1)
+      nb=nb+1
+      
+      if (MOD(nb,NbCol)==0) then
+        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16,/)'
+        Pos=2
+      else
+        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16," | ",)'
+        Pos=Pos+ColumnSize
+      endif
+      write (id,form,advance='no') i,Field(i)
+    enddo
+     
+    close(id)
+
+  end subroutine write_field1D
+
+  subroutine write_field2D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=2
+    character(len=*)   :: name
+    real, dimension(:,:) :: Field
+    real, dimension(:,:),allocatable :: New_Field
+    character(len=20) :: str
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,j,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos,offset
+    character(len=255) :: form
+    character(len=255) :: spacing
+    
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'",//)')
+    
+    Dim=shape(Field)
+    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+3
+    ColumnSize=20+6+3+offset
+
+    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
+    
+    do i=1,Dim(2)
+      nb=0
+      Pos=2
+      do j=1,Dim(1)
+        nb=nb+1
+      
+        if (MOD(nb,NbCol)==0) then
+          form='(t'//trim(int2str(pos))//            &
+               ',"('//trim(int2str(j))//','          &
+                    //trim(int2str(i))//')",t'       & 
+                    //trim(int2str(pos+offset))     &    
+                    //'," ---> ",g22.16,/)'
+          Pos=2
+        else
+          form='(t'//trim(int2str(pos))//            &
+               ',"('//trim(int2str(j))//','          &
+                    //trim(int2str(i))//')",t'       & 
+                    //trim(int2str(pos+offset))     &    
+                    //'," ---> ",g22.16," | ")'
+          Pos=Pos+ColumnSize
+        endif
+        write (id,form,advance='no') Field(j,i)
+      enddo
+      if (MOD(nb,NbCol)==0) then
+        write (id,spacing)
+      else
+        write (id,'("")')
+        write (id,spacing)
+      endif
+    enddo
+     
+  end subroutine write_field2D
+  
+  subroutine write_field3D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=3
+    character(len=*)   :: name
+    real, dimension(:,:,:) :: Field
+    real, dimension(:,:,:),allocatable :: New_Field
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,j,k,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos,offset
+    character(len=255) :: form
+    character(len=255) :: spacing
+
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'"//)')
+    
+    Dim=shape(Field)
+    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+len(trim(int2str(Dim(3))))+4
+    ColumnSize=22+6+3+offset
+
+!    open(unit=id,file=name,form=formatted
+   
+    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
+    
+    do i=1,Dim(3)
+    
+      do j=1,Dim(2)
+        nb=0
+        Pos=2
+        
+        do k=1,Dim(1)
+        nb=nb+1
+      
+          if (MOD(nb,NbCol)==0) then
+            form='(t'//trim(int2str(pos))//            &
+                 ',"('//trim(int2str(k))//','          &
+                      //trim(int2str(j))//','          &
+                      //trim(int2str(i))//')",t'       & 
+                      //trim(int2str(pos+offset))      &    
+                      //'," ---> ",g22.16,/)'
+           Pos=2
+          else
+            form='(t'//trim(int2str(pos))//            &
+                 ',"('//trim(int2str(k))//','          &
+                      //trim(int2str(j))//','          &
+                      //trim(int2str(i))//')",t'       & 
+                      //trim(int2str(pos+offset))      &    
+                      //'," ---> ",g22.16," | ")'
+! dépent de l'implémention, sur compaq, c'est necessaire
+!            Pos=Pos+ColumnSize
+          endif
+          write (id,form,advance='no') Field(k,j,i)
+        enddo
+        if (MOD(nb,NbCol)==0) then
+          write (id,spacing)
+        else
+          write (id,'("")')
+          write (id,spacing)
+        endif
+      enddo
+      write (id,spacing)
+    enddo
+    
+    close(id)
+  
+  end subroutine write_field3D  
+  
+  function int2str(int)
+    implicit none
+    integer, parameter :: MaxLen=10
+    integer,intent(in) :: int
+    character(len=MaxLen) :: int2str
+    logical :: flag
+    integer :: i
+    flag=.true.
+    
+    i=int
+    
+    int2str=''
+    do while (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      if (i==0) flag=.false.
+    enddo
+  end function int2str
+
+end module write_field
+  
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/writedynav.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/writedynav.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/writedynav.F90	(revision 1403)
@@ -0,0 +1,141 @@
+! $Id: writedynav.F90 1612 2012-01-31 10:11:48Z lguez $
+
+subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
+
+#ifdef CPP_IOIPSL
+  USE ioipsl
+#endif
+  USE infotrac, ONLY : nqtot, ttext
+  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
+
+  implicit none
+
+  !   Ecriture du fichier histoire au format IOIPSL
+
+  !   Appels succesifs des routines: histwrite
+
+  !   Entree:
+  !      time: temps de l'ecriture
+  !      vcov: vents v covariants
+  !      ucov: vents u covariants
+  !      teta: temperature potentielle
+  !      phi : geopotentiel instantane
+  !      q   : traceurs
+  !      masse: masse
+  !      ps   :pression au sol
+  !      phis : geopotentiel au sol
+
+  !   L. Fairhead, LMD, 03/99
+
+  !   Declarations
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "temps.h"
+  include "ener.h"
+  include "logic.h"
+  include "description.h"
+  include "serre.h"
+  include "iniprint.h"
+
+  !   Arguments
+
+  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) 
+  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)     
+  REAL ps(ip1jmp1), masse(ip1jmp1, llm)                   
+  REAL phis(ip1jmp1)                  
+  REAL q(ip1jmp1, llm, nqtot)
+  integer time
+
+#ifdef CPP_IOIPSL
+  ! This routine needs IOIPSL to work
+  !   Variables locales
+
+  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
+  INTEGER iq, ii, ll
+  real tm(ip1jmp1*llm)
+  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) 
+  logical ok_sync
+  integer itau_w
+
+  !-----------------------------------------------------------------
+
+  !  Initialisations
+
+  ndexu = 0
+  ndexv = 0
+  ndex2d = 0
+  ok_sync = .TRUE.
+  tm = 999.999
+  vnat = 999.999
+  unat = 999.999
+  itau_w = itau_dyn + time
+
+  ! Passage aux composantes naturelles du vent
+  call covnat(llm, ucov, vcov, unat, vnat)
+
+  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
+
+  !  Vents U 
+
+  call histwrite(histuaveid, 'u', itau_w, unat,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Vents V
+
+  call histwrite(histvaveid, 'v', itau_w, vnat,  &
+       iip1*jjm*llm, ndexv)
+
+  !  Temperature potentielle moyennee
+
+  call histwrite(histaveid, 'theta', itau_w, teta,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Temperature moyennee
+
+  do ii = 1, ijp1llm
+     tm(ii) = teta(ii) * ppk(ii)/cpp
+  enddo
+  call histwrite(histaveid, 'temp', itau_w, tm,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Geopotentiel
+
+  call histwrite(histaveid, 'phi', itau_w, phi,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Traceurs
+
+  !  DO iq=1, nqtot
+  !       call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
+  !                   iip1*jjp1*llm, ndexu)
+  ! enddo
+
+  !  Masse
+
+  call histwrite(histaveid, 'masse', itau_w, masse,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Pression au sol
+
+  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
+
+  ! Geopotentiel au sol
+
+  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+
+  if (ok_sync) then
+     call histsync(histaveid)
+     call histsync(histvaveid)
+     call histsync(histuaveid)
+  ENDIF
+
+#else
+  write(lunout, *) "writedynav: Warning this routine should not be", &
+       " used without ioipsl"
+#endif
+  ! of #ifdef CPP_IOIPSL
+
+end subroutine writedynav
Index: /trunk/LMDZ.COMMON/libf/dyn3d_common/writehist.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3d_common/writehist.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dyn3d_common/writehist.F	(revision 1403)
@@ -0,0 +1,136 @@
+!
+! $Id: writehist.F 1403 2010-07-01 09:02:53Z fairhead $
+!
+      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
+
+#ifdef CPP_IOIPSL
+      USE ioipsl
+#endif
+      USE infotrac, ONLY : nqtot, ttext
+      use com_io_dyn_mod, only : histid,histvid,histuid
+      implicit none
+
+C
+C   Ecriture du fichier histoire au format IOIPSL
+C
+C   Appels succesifs des routines: histwrite
+C
+C   Entree:
+C      time: temps de l'ecriture
+C      vcov: vents v covariants
+C      ucov: vents u covariants
+C      teta: temperature potentielle
+C      phi : geopotentiel instantane
+C      q   : traceurs
+C      masse: masse
+C      ps   :pression au sol
+C      phis : geopotentiel au sol
+C      
+C
+C   L. Fairhead, LMD, 03/99
+C
+C =====================================================================
+C
+C   Declarations
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "iniprint.h"
+
+C
+C   Arguments
+C
+
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
+      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
+      REAL phis(ip1jmp1)                  
+      REAL q(ip1jmp1,llm,nqtot)
+      integer time
+
+
+#ifdef CPP_IOIPSL
+! This routine needs IOIPSL to work
+C   Variables locales
+C
+      integer iq, ii, ll
+      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
+      logical ok_sync
+      integer itau_w
+      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
+
+C
+C  Initialisations
+C
+      ndexu = 0
+      ndexv = 0
+      ndex2d = 0
+      ok_sync =.TRUE.
+      itau_w = itau_dyn + time
+!  Passage aux composantes naturelles du vent
+      call covnat(llm, ucov, vcov, unat, vnat)
+C
+C  Appels a histwrite pour l'ecriture des variables a sauvegarder
+C
+C  Vents U
+C
+      call histwrite(histuid, 'u', itau_w, unat, 
+     .               iip1*jjp1*llm, ndexu)
+C
+C  Vents V
+C
+      call histwrite(histvid, 'v', itau_w, vnat, 
+     .               iip1*jjm*llm, ndexv)
+
+C
+C  Temperature potentielle
+C
+      call histwrite(histid, 'teta', itau_w, teta, 
+     .                iip1*jjp1*llm, ndexu)
+C
+C  Geopotentiel
+C
+      call histwrite(histid, 'phi', itau_w, phi, 
+     .                iip1*jjp1*llm, ndexu)
+C
+C  Traceurs
+C
+!        DO iq=1,nqtot
+!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), 
+!     .                   iip1*jjp1*llm, ndexu)
+!        enddo
+!C
+C  Masse
+C
+      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
+C
+C  Pression au sol
+C
+      call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
+C
+C  Geopotentiel au sol
+C
+!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+C
+C  Fin
+C
+      if (ok_sync) then
+        call histsync(histid)
+        call histsync(histvid)
+        call histsync(histuid)
+      endif
+#else
+! tell the user this routine should be run with ioipsl
+      write(lunout,*)"writehist: Warning this routine should not be",
+     &               " used without ioipsl"
+#endif
+! of #ifdef CPP_IOIPSL
+      return
+      end
Index: unk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F	(revision 1402)
+++ 	(revision )
@@ -1,1443 +1,0 @@
-!
-! $Id: calfis_p.F 1407 2010-07-07 10:31:52Z fairhead $
-!
-C
-C
-      SUBROUTINE calfis_p(lafin,
-     $                  jD_cur, jH_cur,
-     $                  pucov,
-     $                  pvcov,
-     $                  pteta,
-     $                  pq,
-     $                  pmasse,
-     $                  pps,
-     $                  pp,
-     $                  ppk,
-     $                  pphis,
-     $                  pphi,
-     $                  pducov,
-     $                  pdvcov,
-     $                  pdteta,
-     $                  pdq,
-     $                  flxw,
-     $                  pdufi,
-     $                  pdvfi,
-     $                  pdhfi,
-     $                  pdqfi,
-     $                  pdpsfi)
-#ifdef CPP_PHYS
-! Ehouarn: if using (parallelized) physics
-      USE dimphy
-      USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root 
-      USE mod_interface_dyn_phys
-!      USE IOPHY
-#endif
-      USE parallel_lmdz, ONLY : omp_chunk, using_mpi, AllGather_Field
-      USE Write_Field
-      Use Write_field_p
-      USE Times
-      USE infotrac, ONLY: nqtot, niadv, tname
-      USE control_mod, ONLY: planet_type, nsplit_phys
-      USE cpdet_mod, only: tpot2t_p, t2tpot_p
-
-! used only for zonal averages
-      USE moyzon_mod
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   1. rearrangement des tableaux et transformation
-c      variables dynamiques  >  variables physiques
-c   2. calcul des termes physiques
-c   3. retransformation des tendances physiques en tendances dynamiques
-c
-c   remarques:
-c   ----------
-c
-c    - les vents sont donnes dans la physique par leurs composantes 
-c      naturelles.
-c    - la variable thermodynamique de la physique est une variable
-c      intensive :   T 
-c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
-c    - les deux seules variables dependant de la geometrie necessaires
-c      pour la physique sont la latitude pour le rayonnement et 
-c      l'aire de la maille quand on veut integrer une grandeur 
-c      horizontalement.
-c    - les points de la physique sont les points scalaires de la 
-c      la dynamique; numerotation:
-c          1 pour le pole nord
-c          (jjm-1)*iim pour l'interieur du domaine
-c          ngridmx pour le pole sud
-c      ---> ngridmx=2+(jjm-1)*iim
-c
-c     Input :
-c     -------
-c       ecritphy        frequence d'ecriture (en jours)de histphy
-c       pucov           covariant zonal velocity
-c       pvcov           covariant meridional velocity 
-c       pteta           potential temperature
-c       pps             surface pressure
-c       pmasse          masse d'air dans chaque maille
-c       pts             surface temperature  (K)
-c       callrad         clef d'appel au rayonnement
-c
-c    Output :
-c    --------
-c        pdufi          tendency for the natural zonal velocity (ms-1)
-c        pdvfi          tendency for the natural meridional velocity 
-c        pdhfi          tendency for the potential temperature (K/s)
-c        pdtsfi         tendency for the surface temperature
-c
-c        pdtrad         radiative tendencies  \  both input
-c        pfluxrad       radiative fluxes      /  and output
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "logic.h"
-
-      INTEGER ngridmx
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "iniprint.h"
-#ifdef CPP_MPI
-      include 'mpif.h'
-#endif
-c    Arguments :
-c    -----------
-      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
-      REAL,INTENT(IN) :: jD_cur, jH_cur
-      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
-      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
-      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
-      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
-      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
-      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
-      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
-
-      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
-      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
-      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
-! commentaire SL: pdq ne sert que pour le calcul de pcvgq,
-! qui lui meme ne sert a rien dans la routine telle qu'elle est
-! ecrite, et que j'ai donc commente....
-      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
-      ! NB: pdq is only used to compute pcvgq which is in fact not used...
-
-      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
-      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
-      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
-      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
-
-      ! tendencies (in */s) from the physics
-      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
-      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
-      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
-      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
-      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
-
-#ifdef CPP_PHYS
-c    Local variables :
-c    -----------------
-
-      INTEGER i,j,l,ig0,ig,iq,iiq
-      REAL,ALLOCATABLE,SAVE :: zpsrf(:)
-      REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
-      REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
-
-      REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
-      REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
-! ADAPTATION GCM POUR CP(T)
-      REAL,ALLOCATABLE,SAVE :: zteta(:,:)
-      REAL,ALLOCATABLE,SAVE ::  zpk(:,:)
-
-! Ces calculs ne servent pas. 
-! Si necessaire, decommenter ces variables et les calculs...
-!      REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
-!      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
-c
-      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
-      REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
-      REAL,SAVE,ALLOCATABLE ::  flxwfi(:,:)     ! Flux de masse verticale sur la grille physiq
-
-      REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zpk_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zphis_omp(:)
-      REAL,ALLOCATABLE,SAVE :: presnivs_omp(:)
-      REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 
-      REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
-      REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:)
-      REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:)
-      REAL,SAVE,ALLOCATABLE ::  flxwfi_omp(:,:)     ! Flux de masse verticale sur la grille physiq
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Introduction du splitting (FH)
-! Question pour Yann :
-! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent
-! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
-! soit allocatable (plutot par exemple que de passer une dimension
-! dépendant du process en argument des routines) et que, du coup,
-! le SAVE évite d'avoir à refaire l'allocation à chaque appel.
-! Tu confirmes ?
-! J'ai suivi le même principe pour les zdufic_omp
-! Mais c'est surement bien que tu controles.
-! 
-
-      REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:)
-      REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:)
-      REAL jH_cur_split,zdt_split
-      LOGICAL debut_split,lafin_split
-      INTEGER isplit
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp,
-c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
-c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
-c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp,
-c$OMP+                 zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)       
-
-      LOGICAL,SAVE :: first_omp=.true.
-c$OMP THREADPRIVATE(first_omp)
-      
-      REAL zsin(iim),zcos(iim),z1(iim)
-      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
-      REAL unskap, pksurcp
-      save unskap
-
-      REAL SSUM
-
-      LOGICAL,SAVE :: firstcal=.true., debut=.true.
-c$OMP THREADPRIVATE(firstcal,debut)
-      
-      REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
-      INTEGER :: ierr
-#ifdef CPP_MPI
-      INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
-#else
-      INTEGER,dimension(1,4) :: Status
-#endif
-      INTEGER, dimension(4) :: Req
-      REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
-      integer :: k,kstart,kend
-      INTEGER :: offset  
-
-      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
-
-! For Titan only right now: 
-! to allow for 2D computation of microphys and chemistry
-      LOGICAL,save :: flag_moyzon
-      REAL,allocatable,save :: tmpvar(:,:)
-      REAL,allocatable,save :: tmpvarp1(:,:)
-      REAL,allocatable,save :: tmpvarbar(:)
-      REAL,allocatable,save :: tmpvarbarp1(:)
-      real :: zz1,zz2
-
-c-----------------------------------------------------------------------
-
-c    1. Initialisations :
-c    --------------------
-
-
-      klon=klon_mpi
-      
-      IF ( firstcal )  THEN
-        debut = .TRUE.
-        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         write(lunout,*) 'STOP dans calfis'
-         write(lunout,*) 
-     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         write(lunout,*) '  ngridmx  jjm   iim   '
-         write(lunout,*) ngridmx,jjm,iim
-         STOP
-        ENDIF
-
-        unskap   = 1./ kappa
-
-c$OMP MASTER
-        flag_moyzon = .false.
-        if(moyzon_ch.or.moyzon_mu) then
-         flag_moyzon = .true.
-         allocate(tmpvar(iip1,llm))
-         allocate(tmpvarp1(iip1,llmp1))
-         allocate(tmpvarbar(llm))
-         allocate(tmpvarbarp1(llmp1))
-        endif
-
-      ALLOCATE(zpsrf(klon))
-      ALLOCATE(zplev(klon,llm+1),zplay(klon,llm))
-      ALLOCATE(zphi(klon,llm),zphis(klon))
-      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
-      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
-!      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
-!      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
-      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
-      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
-      ALLOCATE(zdpsrf(klon))
-      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
-      ALLOCATE(flxwfi(klon,llm))
-! ADAPTATION GCM POUR CP(T)
-      ALLOCATE(zteta(klon,llm))
-      ALLOCATE(zpk(klon,llm))
-
-      ! zonal means. horizontal dimension should be iip1
-      if (flag_moyzon) call moyzon_init(klon,llm,nqtot)
-
-c------------------------------------------------------------------
-c moyennes globales pour les profils de pression et de temperature
-      if(planet_type.eq."titan".or.planet_type.eq."venus") then
-        call AllGather_Field(pp,iip1*jjp1,llmp1)
-        call AllGather_Field(pteta,iip1*jjp1,llm)
-        call AllGather_Field(ppk,iip1*jjp1,llm)
-        call AllGather_Field(pphi,iip1*jjp1,llm)
-        call AllGather_Field(pphis,iip1*jjp1,1)
-        ALLOCATE(plevmoy(llm+1))
-        ALLOCATE(playmoy(llm))
-        ALLOCATE(tmoy(llm))
-        ALLOCATE(tetamoy(llm))
-        ALLOCATE(pkmoy(llm))
-        ALLOCATE(phimoy(0:llm))
-        ALLOCATE(zlevmoy(llm+1))
-        ALLOCATE(zlaymoy(llm))
-        plevmoy=0.
-        do l=1,llmp1
-         do i=1,iip1
-          do j=1,jjp1
-            plevmoy(l)=plevmoy(l)+pp(i,j,l)/(iip1*jjp1)
-          enddo
-         enddo
-        enddo
-        tetamoy=0.
-        pkmoy=0.
-        phimoy=0.
-        do i=1,iip1
-         do j=1,jjp1
-            phimoy(0)=phimoy(0)+pphis(i,j)/(iip1*jjp1)
-         enddo
-        enddo
-        do l=1,llm
-         do i=1,iip1
-          do j=1,jjp1
-            tetamoy(l)=tetamoy(l)+pteta(i,j,l)/(iip1*jjp1)
-            pkmoy(l)=pkmoy(l)+ppk(i,j,l)/(iip1*jjp1)
-            phimoy(l)=phimoy(l)+pphi(i,j,l)/(iip1*jjp1)
-          enddo
-         enddo
-        enddo
-        playmoy(:) = preff * (pkmoy(:)/cpp) ** unskap
-        call tpot2t_p(1,llm,tetamoy,tmoy,pkmoy)
-c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
-        zlaymoy(:) = g*rad*rad/(g*rad-phimoy(:))-rad
-        zlevmoy(1) = phimoy(0)/g
-        DO l=2,llm
-            zz1=(playmoy(l-1)+plevmoy(l))/(playmoy(l-1)-plevmoy(l))
-            zz2=(plevmoy(l)  +playmoy(l))/(plevmoy(l)  -playmoy(l))
-            zlevmoy(l)=(zz1*zlaymoy(l-1)+zz2*zlaymoy(l))/(zz1+zz2)
-        ENDDO
-        zlevmoy(llmp1)=zlaymoy(llm)+(zlaymoy(llm)-zlevmoy(llm))
-c-------------------
-c + lat index
-        allocate(klat(klon))
-        do ig0=1,klon
-          j=index_j(ig0)
-          klat(ig0)=j
-        enddo
-      endif   ! planet_type=titan
-c------------------------------------------------------------------
-
-c$OMP END MASTER
-c$OMP BARRIER	  
-      ELSE
-          debut = .FALSE.
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c   40. transformation des variables dynamiques en variables physiques:
-c   ---------------------------------------------------------------
-
-c   41. pressions au sol (en Pascals)
-c   ----------------------------------
-
-c$OMP MASTER
-      call start_timer(timer_physic)
-c$OMP END MASTER
-
-c$OMP MASTER             
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-      do ig0=1,klon
-        i=index_i(ig0)
-        j=index_j(ig0)
-        zpsrf(ig0)=pps(i,j)
-      enddo
-c$OMP END MASTER
-
-
-c   42. pression intercouches et fonction d'Exner:
-
-c   -----------------------------------------------------------------
-c     .... zplev  definis aux (llm +1) interfaces des couches  ....
-c     .... zplay  definis aux (  llm )    milieux des couches  .... 
-c   -----------------------------------------------------------------
-
-c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
-
-c      print *,omp_rank,'klon--->',klon
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l = 1, llmp1
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-        do ig0=1,klon
-          i=index_i(ig0)
-          j=index_j(ig0)
-          zplev( ig0,l ) = pp(i,j,l)
-        enddo
-      ENDDO
-c$OMP END DO NOWAIT
-      if (flag_moyzon) then
-        call AllGather_Field(pp,iip1*jjp1,llmp1)
-        j=index_j(1)
-        tmpvarp1(:,:) = pp(:,j,:)
-        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
-        zplevbar_mpi(1,:) = tmpvarbarp1
-        do ig0=2,klon
-          j=index_j(ig0)
-          if (j.ne.index_j(ig0-1)) then
-            tmpvarp1(:,:) = pp(:,j,:)
-            call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
-            zplevbar_mpi(ig0,:) = tmpvarbarp1
-          else
-            zplevbar_mpi(ig0,:) = zplevbar_mpi(ig0-1,:)
-          endif
-        enddo
-      endif
-
-! ADAPTATION GCM POUR CP(T)
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-        do ig0=1,klon
-          i=index_i(ig0)
-          j=index_j(ig0)
-          zpk(ig0,l)=ppk(i,j,l)
-          zteta(ig0,l)=pteta(i,j,l)
-        enddo
-      ENDDO
-c$OMP END DO NOWAIT
-      if (flag_moyzon) then
-        call AllGather_Field(pteta,iip1*jjp1,llm)
-        call AllGather_Field(ppk,iip1*jjp1,llm)
-        j=index_j(1)
-        tmpvar(:,:) = pteta(:,j,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        ztetabar_mpi(1,:) = tmpvarbar
-        tmpvar(:,:) = ppk(:,j,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zpkbar_mpi(1,:) = tmpvarbar
-        call tpot2t_p(1,llm,ztetabar_mpi(1,:),ztfibar_mpi(1,:),
-     &                      zpkbar_mpi(1,:))
-        do ig0=2,klon
-          j=index_j(ig0)
-          if (j.ne.index_j(ig0-1)) then
-            tmpvar(:,:) = pteta(:,j,:)
-            call moyzon(llm,tmpvar,tmpvarbar)
-            ztetabar_mpi(ig0,:) = tmpvarbar
-            tmpvar(:,:) = ppk(:,j,:)
-            call moyzon(llm,tmpvar,tmpvarbar)
-            zpkbar_mpi(ig0,:) = tmpvarbar
-            call tpot2t_p(1,llm,ztetabar_mpi(ig0,:),ztfibar_mpi(ig0,:),
-     &                          zpkbar_mpi(ig0,:))
-          else
-            zpkbar_mpi(ig0,:)   = zpkbar_mpi(ig0-1,:)
-            ztetabar_mpi(ig0,:) = ztetabar_mpi(ig0-1,:)
-            ztfibar_mpi(ig0,:)  = ztfibar_mpi(ig0-1,:)
-          endif
-        enddo
-      endif
-
-c   43. temperature naturelle (en K) et pressions milieux couches .
-c   ---------------------------------------------------------------
-
-! ADAPTATION GCM POUR CP(T)
-         call tpot2t_p(klon,llm,zteta,ztfi,zpk)
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-        do ig0=1,klon
-          i=index_i(ig0)
-          j=index_j(ig0)
-          pksurcp        = ppk(i,j,l) / cpp
-          zplay(ig0,l)   = preff * pksurcp ** unskap
-        enddo
-      ENDDO
-c$OMP END DO NOWAIT
-      if (flag_moyzon) then
-        zplaybar_mpi(:,:) = preff * (zpkbar_mpi(:,:)/cpp)**unskap
-      endif
-
-c   43.bis traceurs (tous intensifs)
-c   ---------------
-
-      DO iq=1,nqtot
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-         DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-           do ig0=1,klon
-             i=index_i(ig0)
-             j=index_j(ig0)
-             zqfi(ig0,l,iq)  = pq(i,j,l,iq)
-           enddo
-         ENDDO
-c$OMP END DO NOWAIT	 
-      ENDDO ! of DO iq=1,nqtot
-      if (flag_moyzon) then
-       DO iq=1,nqtot
-         call AllGather_Field(pq(:,:,:,iq),iip1*jjp1,llm)
-         j=index_j(1)
-         tmpvar(:,:) = pq(:,j,:,iq)
-         call moyzon(llm,tmpvar,tmpvarbar)
-         zqfibar_mpi(1,:,iq) = tmpvarbar
-         do ig0=2,klon
-          j=index_j(ig0)
-          if (j.ne.index_j(ig0-1)) then
-            tmpvar(:,:) = pq(:,j,:,iq)
-            call moyzon(llm,tmpvar,tmpvarbar)
-            zqfibar_mpi(ig0,:,iq) = tmpvarbar
-          else
-            zqfibar_mpi(ig0,:,iq) = zqfibar_mpi(ig0-1,:,iq)
-          endif
-        enddo
-       ENDDO ! of DO iq=1,nqtot
-      endif
-
-
-c   Geopotentiel calcule par rapport a la surface locale:
-c   -----------------------------------------------------
-
-      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
-
-      CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
-
-c$OMP BARRIER
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-	 DO ig=1,klon
-	   zphi(ig,l)=zphi(ig,l)-zphis(ig)
-	 ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-      
-      if (flag_moyzon) then
-        call AllGather_Field(pphis,iip1*jjp1,1)
-        call AllGather_Field(pphi,iip1*jjp1,llm)
-        j=index_j(1)
-        tmpvar(:,1) = pphis(:,j)
-        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
-        zphisbar_mpi(1) = tmpvarbar(1)
-        tmpvar(:,:) = pphi(:,j,:)
-        call moyzon(llm,tmpvar,tmpvarbar)
-        zphibar_mpi(1,:) = tmpvarbar-zphisbar_mpi(1)
-        do ig0=2,klon
-          j=index_j(ig0)
-          if (j.ne.index_j(ig0-1)) then
-            tmpvar(:,1) = pphis(:,j)
-            call moyzon(1,tmpvar(:,1),tmpvarbar(1))
-            zphisbar_mpi(ig0) = tmpvarbar(1)
-            tmpvar(:,:) = pphi(:,j,:)
-            call moyzon(llm,tmpvar,tmpvarbar)
-            zphibar_mpi(ig0,:) = tmpvarbar-zphisbar_mpi(ig0)
-          else
-            zphisbar_mpi(ig0)  = zphisbar_mpi(ig0-1)
-            zphibar_mpi(ig0,:) = zphibar_mpi(ig0-1,:)
-          endif
-        enddo
-      endif
-
-c
-c   45. champ u:
-c   ------------
-
-      kstart=1
-      kend=klon
-      
-      if (is_north_pole) kstart=2
-      if (is_south_pole) kend=klon-1
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-!CDIR SPARSE
-        do ig0=kstart,kend
-          i=index_i(ig0)
-          j=index_j(ig0)
-          if (i==1) then
-            zufi(ig0,l)= 0.5 *(  pucov(iim,j,l)/cu(iim,j)
-     $                         + pucov(1,j,l)/cu(1,j) )
-          else
-            zufi(ig0,l)= 0.5*(  pucov(i-1,j,l)/cu(i-1,j) 
-     $                       + pucov(i,j,l)/cu(i,j) )
-          endif
-        enddo
-      ENDDO
-c$OMP END DO NOWAIT
-
-c   46.champ v:
-c   -----------
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-        DO ig0=kstart,kend
-          i=index_i(ig0)
-          j=index_j(ig0)
-          zvfi(ig0,l)= 0.5 *(  pvcov(i,j-1,l)/cv(i,j-1) 
-     $                       + pvcov(i,j,l)/cv(i,j) )
-    
-         ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-c   47. champs de vents aux pole nord   
-c   ------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      if (is_north_pole) then
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-        DO l=1,llm
-
-           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
-           DO i=2,iim
-              z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
-           ENDDO
-  
-           DO i=1,iim
-              zcos(i)   = COS(rlonv(i))*z1(i)
-              zsin(i)   = SIN(rlonv(i))*z1(i)
-           ENDDO
-  
-           zufi(1,l)  = SSUM(iim,zcos,1)/pi
-           zvfi(1,l)  = SSUM(iim,zsin,1)/pi
-  
-        ENDDO
-c$OMP END DO NOWAIT      
-      endif
-
-
-c   48. champs de vents aux pole sud:
-c   ---------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      if (is_south_pole) then
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-        DO l=1,llm
-  
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
-           DO i=2,iim
-             z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
-	   ENDDO
-  
-           DO i=1,iim
-              zcos(i)    = COS(rlonv(i))*z1(i)
-              zsin(i)    = SIN(rlonv(i))*z1(i)
-	   ENDDO
-  
-           zufi(klon,l)  = SSUM(iim,zcos,1)/pi
-           zvfi(klon,l)  = SSUM(iim,zsin,1)/pi
-        ENDDO
-c$OMP END DO NOWAIT       
-      endif
-
-c On change de grille, dynamique vers physiq, pour le flux de masse verticale
-      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
-
-c-----------------------------------------------------------------------
-c   Appel de la physique:
-c   ---------------------
-
-! Appel de la physique: pose probleme quand on tourne 
-! SANS physique, car physiq.F est dans le repertoire phy[]... 
-! Il faut une cle CPP_PHYS
-
-! Le fait que les arguments de physiq soient differents selon les planetes 
-! ne pose pas de probleme a priori.
-
-
-c$OMP BARRIER
-      if (first_omp) then
-        klon=klon_omp
-
-        allocate(zplev_omp(klon,llm+1))
-        allocate(zplay_omp(klon,llm))
-        allocate(zpk_omp(klon,llm))
-        allocate(zphi_omp(klon,llm))
-        allocate(zphis_omp(klon))
-        allocate(presnivs_omp(llm))
-        allocate(zufi_omp(klon,llm))
-        allocate(zvfi_omp(klon,llm))
-        allocate(ztfi_omp(klon,llm))
-        allocate(zqfi_omp(klon,llm,nqtot))
-        allocate(zdufi_omp(klon,llm))
-        allocate(zdvfi_omp(klon,llm))
-        allocate(zdtfi_omp(klon,llm))
-        allocate(zdqfi_omp(klon,llm,nqtot))
-        allocate(zdufic_omp(klon,llm))
-        allocate(zdvfic_omp(klon,llm))
-        allocate(zdtfic_omp(klon,llm))
-        allocate(zdqfic_omp(klon,llm,nqtot))
-        allocate(zdpsrf_omp(klon))
-        allocate(flxwfi_omp(klon,llm))
-
-        if (flag_moyzon) call moyzon_init_omp(klon,llm,nqtot)
-
-	first_omp=.false.
-      endif
-       
-	   
-      klon=klon_omp
-      offset=klon_omp_begin-1
-      
-      do l=1,llm+1
-        do i=1,klon
-          zplev_omp(i,l)=zplev(offset+i,l)
-	enddo 
-      enddo
-	  
-       do l=1,llm
-        do i=1,klon  
-	  zplay_omp(i,l)=zplay(offset+i,l)
-	enddo 
-      enddo
-	
-       do l=1,llm
-        do i=1,klon  
-	  zpk_omp(i,l)=zpk(offset+i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zphi_omp(i,l)=zphi(offset+i,l)
-	enddo 
-      enddo
-	
-      do i=1,klon
-	zphis_omp(i)=zphis(offset+i)
-      enddo 
-     
-	
-      do l=1,llm
-        presnivs_omp(l)=presnivs(l)
-      enddo 
-	
-      do l=1,llm
-        do i=1,klon
-	  zufi_omp(i,l)=zufi(offset+i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zvfi_omp(i,l)=zvfi(offset+i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  ztfi_omp(i,l)=ztfi(offset+i,l)
-	enddo 
-      enddo
-	
-      do iq=1,nqtot
-        do l=1,llm
-          do i=1,klon
-            zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
-	  enddo
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zdufi_omp(i,l)=zdufi(offset+i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zdvfi_omp(i,l)=zdvfi(offset+i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-          zdtfi_omp(i,l)=zdtfi(offset+i,l)
-	enddo 
-      enddo
-	
-      do iq=1,nqtot
-        do l=1,llm
-          do i=1,klon
-	    zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
-	  enddo 
-        enddo
-      enddo
-      	
-      do i=1,klon
-	zdpsrf_omp(i)=zdpsrf(offset+i)
-      enddo 
-
-      do l=1,llm
-        do i=1,klon
-          flxwfi_omp(i,l)=flxwfi(offset+i,l)
-	enddo 
-      enddo
-
-      if (flag_moyzon) then
-       do l=1,llm+1
-        do i=1,klon
-          zplevbar(i,l)=zplevbar_mpi(offset+i,l)
-	enddo 
-       enddo
-	  
-       do l=1,llm
-        do i=1,klon  
-	  zplaybar(i,l)=zplaybar_mpi(offset+i,l)
-	enddo 
-       enddo
-	
-       do l=1,llm
-        do i=1,klon
-	  zphibar(i,l)=zphibar_mpi(offset+i,l)
-	enddo 
-       enddo
-		
-      do i=1,klon
-	zphisbar(i)=zphisbar_mpi(offset+i)
-      enddo 
-     
-      do l=1,llm
-        do i=1,klon
-	  ztfibar(i,l)=ztfibar_mpi(offset+i,l)
-	enddo 
-      enddo
-	
-      do iq=1,nqtot
-        do l=1,llm
-          do i=1,klon
-            zqfibar(i,l,iq)=zqfibar_mpi(offset+i,l,iq)
-	  enddo
-	enddo 
-       enddo
-      endif
-
-      
-c$OMP BARRIER
-
-!$OMP MASTER
-!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
-!$OMP END MASTER
-      zdt_split=dtphys/nsplit_phys
-      zdufic_omp(:,:)=0.
-      zdvfic_omp(:,:)=0.
-      zdtfic_omp(:,:)=0.
-      zdqfic_omp(:,:,:)=0.
-
-#ifdef CPP_PHYS
-      do isplit=1,nsplit_phys
-
-         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
-         debut_split=debut.and.isplit==1
-         lafin_split=lafin.and.isplit==nsplit_phys
-
-
-      if (planet_type=="earth") then
-        CALL physiq (klon,
-     .             llm,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev_omp,
-     .             zplay_omp,
-     .             zphi_omp,
-     .             zphis_omp,
-     .             presnivs_omp,
-     .             zufi_omp,
-     .             zvfi_omp,
-     .             ztfi_omp,
-     .             zqfi_omp,
-c#ifdef INCA
-     .             flxwfi_omp,
-c#endif
-     .             zdufi_omp,
-     .             zdvfi_omp,
-     .             zdtfi_omp,
-     .             zdqfi_omp,
-     .             zdpsrf_omp,
-     .             pducov)
-
-      else if ( planet_type=="generic" ) then
-
-      CALL physiq (klon,     !! ngrid
-     .             llm,            !! nlayer
-     .             nqtot,          !! nq
-     .             tname,          !! tracer names from dynamical core (given in infotrac)
-     .             debut_split,    !! firstcall 
-     .             lafin_split,    !! lastcall
-     .             jD_cur,         !! pday. see leapfrog_p 
-     .             jH_cur_split,   !! ptime "fraction of day"
-     .             zdt_split,      !! ptimestep
-     .             zplev_omp,  !! pplev
-     .             zplay_omp,  !! pplay
-     .             zphi_omp,   !! pphi
-     .             zufi_omp,   !! pu
-     .             zvfi_omp,   !! pv
-     .             ztfi_omp,   !! pt
-     .             zqfi_omp,   !! pq
-     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
-     .             zdufi_omp,  !! pdu
-     .             zdvfi_omp,  !! pdv
-     .             zdtfi_omp,  !! pdt
-     .             zdqfi_omp,  !! pdq
-     .             zdpsrf_omp, !! pdpsrf
-     .             tracerdyn)      !! tracerdyn <-- utilite ???
-
-      else if ( planet_type=="mars" ) then
-
-        CALL physiq (klon,       ! ngrid
-     .             llm,          ! nlayer
-     .             nqtot,        ! nq
-     .             debut_split,  ! firstcall
-     .             lafin_split,  ! lastcall
-     .             jD_cur,       ! pday
-     .             jH_cur_split, ! ptime
-     .             zdt_split,    ! ptimestep
-     .             zplev_omp,    ! pplev
-     .             zplay_omp,    ! pplay
-     .             zphi_omp,     ! pphi
-     .             zufi_omp,     ! pu
-     .             zvfi_omp,     ! pv
-     .             ztfi_omp,     ! pt
-     .             zqfi_omp,     ! pq
-     .             flxwfi_omp,   ! pw
-     .             zdufi_omp,    ! pdu
-     .             zdvfi_omp,    ! pdv
-     .             zdtfi_omp,    ! pdt
-     .             zdqfi_omp,    ! pdq
-     .             zdpsrf_omp,   ! pdpsrf
-     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
-
-      else if ((planet_type=="titan").or.(planet_type=="venus")) then
-
-        CALL physiq (klon,
-     .             llm,
-     .             nqtot,
-     .             debut_split,
-     .             lafin_split,
-     .             jD_cur,
-     .             jH_cur_split,
-     .             zdt_split,
-     .             zplev_omp,
-     .             zplay_omp,
-     .             zpk_omp,
-     .             zphi_omp,
-     .             zphis_omp,
-     .             presnivs_omp,
-     .             zufi_omp,
-     .             zvfi_omp,
-     .             ztfi_omp,
-     .             zqfi_omp,
-     .             flxwfi_omp,
-     .             zdufi_omp,
-     .             zdvfi_omp,
-     .             zdtfi_omp,
-     .             zdqfi_omp,
-     .             zdpsrf_omp)
-
-      else ! unknown "planet_type"
-
-        write(lunout,*) "calfis_p: error, unknown planet_type: ",
-     &                  trim(planet_type)
-        stop
-
-      endif ! planet_type
-         zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
-         zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
-         ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
-         zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
-
-         zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
-         zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
-         zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
-         zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
-
-      enddo
-
-#endif
-! of #ifdef CPP_PHYS
-
-      zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
-      zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
-      zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
-      zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
-
-c$OMP BARRIER
-
-      do l=1,llm+1
-        do i=1,klon
-          zplev(offset+i,l)=zplev_omp(i,l)
-	enddo 
-      enddo
-	  
-       do l=1,llm
-        do i=1,klon  
-	  zplay(offset+i,l)=zplay_omp(i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zphi(offset+i,l)=zphi_omp(i,l)
-	enddo 
-      enddo
-	
-
-      do i=1,klon
-	zphis(offset+i)=zphis_omp(i)
-      enddo 
-     
-	
-      do l=1,llm
-        presnivs(l)=presnivs_omp(l)
-      enddo 
-	
-      do l=1,llm
-        do i=1,klon
-	  zufi(offset+i,l)=zufi_omp(i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zvfi(offset+i,l)=zvfi_omp(i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  ztfi(offset+i,l)=ztfi_omp(i,l)
-	enddo 
-      enddo
-	
-      do iq=1,nqtot
-        do l=1,llm
-          do i=1,klon
-            zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
-	  enddo
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zdufi(offset+i,l)=zdufi_omp(i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-	  zdvfi(offset+i,l)=zdvfi_omp(i,l)
-	enddo 
-      enddo
-	
-      do l=1,llm
-        do i=1,klon
-          zdtfi(offset+i,l)=zdtfi_omp(i,l)
-	enddo 
-      enddo
-	
-      do iq=1,nqtot
-        do l=1,llm
-          do i=1,klon
-	    zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
-	  enddo 
-        enddo
-      enddo
-      	
-      do i=1,klon
-	zdpsrf(offset+i)=zdpsrf_omp(i)
-      enddo 
-      
-
-      klon=klon_mpi
-500   CONTINUE
-c$OMP BARRIER
-
-c$OMP MASTER
-      call stop_timer(timer_physic)
-c$OMP END MASTER
-
-      IF (using_mpi) THEN
-            
-      if (MPI_rank>0) then
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
-       DO l=1,llm      
-        du_send(1:iim,l)=zdufi(1:iim,l)
-        dv_send(1:iim,l)=zdvfi(1:iim,l)
-       ENDDO
-c$OMP END DO NOWAIT       
-
-c$OMP BARRIER
-#ifdef CPP_MPI 
-c$OMP MASTER
-!$OMP CRITICAL (MPI)
-        call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
-     &                   COMM_LMDZ,Req(1),ierr)
-        call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
-     &                  COMM_LMDZ,Req(2),ierr)
-!$OMP END CRITICAL (MPI)
-c$OMP END MASTER
-#endif
-c$OMP BARRIER
-     
-      endif
-   
-      if (MPI_rank<MPI_Size-1) then
-c$OMP BARRIER
-#ifdef CPP_MPI 
-c$OMP MASTER      
-!$OMP CRITICAL (MPI)
-        call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
-     &                 COMM_LMDZ,Req(3),ierr)
-        call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
-     &                 COMM_LMDZ,Req(4),ierr)
-!$OMP END CRITICAL (MPI)
-c$OMP END MASTER
-#endif
-      endif
-
-c$OMP BARRIER
-
-
-#ifdef CPP_MPI 
-c$OMP MASTER    
-!$OMP CRITICAL (MPI)
-      if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
-        call MPI_WAITALL(4,Req(1),Status,ierr)
-      else if (MPI_rank>0) then
-        call MPI_WAITALL(2,Req(1),Status,ierr)
-      else if (MPI_rank <MPI_Size-1) then
-        call MPI_WAITALL(2,Req(3),Status,ierr)
-      endif
-!$OMP END CRITICAL (MPI)
-c$OMP END MASTER
-#endif
-
-c$OMP BARRIER     
-
-      ENDIF ! using_mpi
-      
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-            
-        zdufi2(1:klon,l)=zdufi(1:klon,l)
-        zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l)
-            
-        zdvfi2(1:klon,l)=zdvfi(1:klon,l)
-        zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l) 
-  
-         pdhfi(:,jj_begin,l)=0
-         pdqfi(:,jj_begin,l,:)=0
-         pdufi(:,jj_begin,l)=0
-         pdvfi(:,jj_begin,l)=0
-         
-         if (.not. is_south_pole) then
-           pdhfi(:,jj_end,l)=0
-           pdqfi(:,jj_end,l,:)=0
-           pdufi(:,jj_end,l)=0
-           pdvfi(:,jj_end,l)=0
-         endif
-      
-       ENDDO 
-c$OMP END DO NOWAIT
-
-c$OMP MASTER
-       pdpsfi(:,jj_begin)=0    
-       if (.not. is_south_pole) then
-	 pdpsfi(:,jj_end)=0
-       endif
-c$OMP END MASTER
-c-----------------------------------------------------------------------
-c   transformation des tendances physiques en tendances dynamiques:
-c   ---------------------------------------------------------------
-
-c  tendance sur la pression :
-c  -----------------------------------
-      CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
-c
-c   62. enthalpie potentielle
-c   ---------------------
-
-      kstart=1
-      kend=klon
-
-      if (is_north_pole) kstart=2
-      if (is_south_pole)  kend=klon-1
-      
-! ADAPTATION GCM POUR CP(T)
-      call t2tpot_p(klon,llm,ztfi,zteta,zpk)
-
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-!cdir NODEP
-        do ig0=kstart,kend
-          i=index_i(ig0)
-          j=index_j(ig0)
-!          pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
-          pdhfi(i,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
-!          if (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
-          if (i==1) then
-            pdhfi(iip1,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
-          endif
-         enddo          
-
-        if (is_north_pole) then
-            DO i=1,iip1
-!              pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
-              pdhfi(i,1,l)    = (zteta(1,l) - pteta(i,1,l))/dtphys
-            enddo
-        endif
-        
-        if (is_south_pole) then
-            DO i=1,iip1
-!              pdhfi(i,jjp1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjp1,l)
-              pdhfi(i,jjp1,l) = (zteta(klon,l) - pteta(i,jjp1,l))/dtphys
-            ENDDO
-        endif
-      ENDDO
-c$OMP END DO NOWAIT
-      
-c   62. humidite specifique
-c   ---------------------
-! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
-!      DO iq=1,nqtot
-!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-!         DO l=1,llm
-!!!cdir NODEP 
-!           do ig0=kstart,kend
-!             i=index_i(ig0)
-!             j=index_j(ig0)
-!             pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq) 
-!             if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq) 
-!           enddo
-!           
-!           if (is_north_pole) then
-!             do i=1,iip1
-!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)             
-!             enddo
-!           endif
-!           
-!           if (is_south_pole) then
-!             do i=1,iip1
-!               pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq) 
-!             enddo
-!           endif
-!         ENDDO
-!c$OMP END DO NOWAIT
-!      ENDDO
-
-c   63. traceurs (tous en intensifs)
-c   ------------
-C     initialisation des tendances
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-        pdqfi(:,:,l,:)=0.
-      ENDDO
-c$OMP END DO NOWAIT	 
-
-C
-!cdir NODEP
-      DO iq=1,nqtot
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-         DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-!cdir NODEP           
-	     DO ig0=kstart,kend
-              i=index_i(ig0)
-              j=index_j(ig0)
-              pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
-              if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
-            ENDDO
-	    
-	    IF (is_north_pole) then
-	      DO i=1,iip1
-                pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
-	      ENDDO
-	    ENDIF
-	    
-	    IF (is_south_pole) then
-	      DO i=1,iip1
-                pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
-	      ENDDO
-	    ENDIF
-	    
-         ENDDO
-c$OMP END DO NOWAIT	 
-      ENDDO
-      
-c   65. champ u:
-c   ------------
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-!cdir NODEP
-         do ig0=kstart,kend
-           i=index_i(ig0)
-           j=index_j(ig0)
-           
-           if (i/=iim) then
-             pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
-           endif
-           
-           if (i==1) then
-              pdufi(iim,j,l)=0.5*(  zdufi2(ig0,l)
-     $                            + zdufi2(ig0+iim-1,l))*cu(iim,j)
-             pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
-           endif
-         
-         enddo
-         
-         if (is_north_pole) then
-           DO i=1,iip1
-            pdufi(i,1,l)    = 0.
-           ENDDO
-         endif
-         
-         if (is_south_pole) then
-           DO i=1,iip1
-            pdufi(i,jjp1,l) = 0.
-           ENDDO
-         endif
-         
-      ENDDO
-c$OMP END DO NOWAIT
-
-c   67. champ v:
-c   ------------
-
-      kstart=1
-      kend=klon
-
-      if (is_north_pole) kstart=2
-      if (is_south_pole)  kend=klon-1-iim
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO l=1,llm
-!CDIR ON_ADB(index_i)
-!CDIR ON_ADB(index_j) 
-!cdir NODEP
-        do ig0=kstart,kend
-           i=index_i(ig0)
-           j=index_j(ig0)
-           pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))*cv(i,j)
-           if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+
-     $	                                    zdvfi2(ig0+iim,l))
-     $				          *cv(i,j)
-        enddo
-         
-      ENDDO
-c$OMP END DO NOWAIT
-
-
-c   68. champ v pres des poles:
-c   ---------------------------
-c      v = U * cos(long) + V * SIN(long)
-
-      if (is_north_pole) then
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-        DO l=1,llm
-
-          DO i=1,iim
-            pdvfi(i,1,l)=
-     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
-       
-            pdvfi(i,1,l)=
-     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
-          ENDDO
-
-          pdvfi(iip1,1,l)  = pdvfi(1,1,l)
-
-        ENDDO
-c$OMP END DO NOWAIT
-
-      endif    
-      
-      if (is_south_pole) then
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-         DO l=1,llm
-  
-           DO i=1,iim
-              pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i))
-     $        +zdvfi(klon,l)*SIN(rlonv(i))
-
-              pdvfi(i,jjm,l)=
-     $        0.5*(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))*cv(i,jjm)
-           ENDDO
-
-           pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
-
-        ENDDO
-c$OMP END DO NOWAIT
-     
-      endif
-c-----------------------------------------------------------------------
-
-700   CONTINUE
- 
-      firstcal = .FALSE.
-
-#else
-      write(lunout,*)
-     & "calfis_p: for now can only work with parallel physics"
-      stop
-#endif
-! of #ifdef CPP_PHYS
-      RETURN
-      END
Index: unk/LMDZ.COMMON/libf/dyn3dpar/gr_dyn_fi_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/gr_dyn_fi_p.F	(revision 1402)
+++ 	(revision )
@@ -1,44 +1,0 @@
-!
-! $Id: gr_dyn_fi_p.F 1615 2012-02-10 15:42:26Z emillour $
-!
-      SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
-#ifdef CPP_PHYS
-! Interface with parallel physics,
-      USE mod_interface_dyn_phys
-      USE dimphy
-      USE parallel_lmdz
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ig,l
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-c      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-c   traitement des point normaux
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,nfield    
-       DO ig=1,klon
-         i=index_i(ig)
-         j=index_j(ig)
-         pfi(ig,l)=pdyn(i,j,l)
-       ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-#endif
-! of #ifdef CPP_PHYS
-      RETURN
-      END
Index: unk/LMDZ.COMMON/libf/dyn3dpar/gr_fi_dyn_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/gr_fi_dyn_p.F	(revision 1402)
+++ 	(revision )
@@ -1,56 +1,0 @@
-!
-! $Id: gr_fi_dyn_p.F 1615 2012-02-10 15:42:26Z emillour $
-!
-      SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
-#ifdef CPP_PHYS
-! Interface with parallel physics,
-      USE mod_interface_dyn_phys
-      USE dimphy
-      use parallel_lmdz
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO ifield=1,nfield
-
-        do ig=1,klon
-          i=index_i(ig)
-          j=index_j(ig)
-          pdyn(i,j,ifield)=pfi(ig,ifield)
-          if (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield)
-	enddo
-
-c   traitement des poles
-      if (pole_nord) then
-        do i=1,im
-	  pdyn(i,1,ifield)=pdyn(1,1,ifield)
-	enddo
-      endif
-       
-      if (pole_sud) then
-        do i=1,im
-	  pdyn(i,jm,ifield)=pdyn(1,jm,ifield)
-	enddo
-      endif
-      
-      ENDDO
-c$OMP END DO NOWAIT
-#endif
-! of #ifdef CPP_PHYS
-      RETURN
-      END
Index: /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1402)
+++ /trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F	(revision 1403)
@@ -163,5 +163,5 @@
       REAL :: secondes
       real :: rdaym_ini
-      logical :: physic
+      logical :: physics
       LOGICAL first,callinigrads
 
@@ -256,6 +256,6 @@
 
       itau = 0
-      physic=.true.
-      if (iflag_phys==0.or.iflag_phys==2) physic=.false.
+      physics=.true.
+      if (iflag_phys==0.or.iflag_phys==2) physics=.false.
 !      iday = day_ini+itau/day_step
 !      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
@@ -433,5 +433,5 @@
      s        apdiss = .TRUE.
          IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
-     s          .and. physic                        ) apphys = .TRUE.
+     s          .and. physics                        ) apphys = .TRUE.
       ELSE
       ! Leapfrog/Matsuno time stepping 
@@ -439,5 +439,5 @@
          IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward )
      s        apdiss = .TRUE.
-         IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE.
+         IF( MOD(itau+1,iphysiq).EQ.0.AND.physics) apphys=.TRUE.
       END IF
 
Index: unk/LMDZ.COMMON/libf/dyn3dpar/mod_interface_dyn_phys.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dyn3dpar/mod_interface_dyn_phys.F90	(revision 1402)
+++ 	(revision )
@@ -1,59 +1,0 @@
-! 
-! $Id: mod_interface_dyn_phys.F90 1615 2012-02-10 15:42:26Z emillour $
-!
-MODULE mod_interface_dyn_phys
-  INTEGER,SAVE,dimension(:),allocatable :: index_i
-  INTEGER,SAVE,dimension(:),allocatable :: index_j
-  
-  
-#ifdef CPP_PHYS
-! Interface with parallel physics,
-CONTAINS
-  
-  SUBROUTINE Init_interface_dyn_phys
-    USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi, is_north_pole, is_south_pole, &
-                                      ii_begin, jj_begin, ii_end, jj_end
-    IMPLICIT NONE
-    include 'dimensions.h'    
-    
-    INTEGER :: i,j,k
-    
-    ALLOCATE(index_i(klon_mpi))
-    ALLOCATE(index_j(klon_mpi))
-    
-    k=1
-    IF (is_north_pole) THEN
-      index_i(k)=1
-      index_j(k)=1
-      k=2
-    ELSE
-      DO i=ii_begin,iim
-	index_i(k)=i
-	index_j(k)=jj_begin
-	k=k+1
-       ENDDO
-    ENDIF
-    
-    DO j=jj_begin+1,jj_end-1
-      DO i=1,iim
-	index_i(k)=i
-	index_j(k)=j
-	k=k+1
-      ENDDO
-    ENDDO
-    
-    IF (is_south_pole) THEN
-      index_i(k)=1
-      index_j(k)=jj_end
-    ELSE
-      DO i=1,ii_end
-	index_i(k)=i
-	index_j(k)=jj_end
-	k=k+1
-       ENDDO
-    ENDIF
-  
-  END SUBROUTINE Init_interface_dyn_phys 
-#endif
-! of #ifdef CPP_PHYS
-END MODULE mod_interface_dyn_phys
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
@@ -0,0 +1,959 @@
+!
+! $Id: calfis.F 1407 2010-07-07 10:31:52Z fairhead $
+!
+C
+C
+      SUBROUTINE calfis(lafin,
+     $                  jD_cur, jH_cur,
+     $                  pucov,
+     $                  pvcov,
+     $                  pteta,
+     $                  pq,
+     $                  pmasse,
+     $                  pps,
+     $                  pp,
+     $                  ppk,
+     $                  pphis,
+     $                  pphi,
+     $                  pducov,
+     $                  pdvcov,
+     $                  pdteta,
+     $                  pdq,
+     $                  flxw,
+     $                  pdufi,
+     $                  pdvfi,
+     $                  pdhfi,
+     $                  pdqfi,
+     $                  pdpsfi)
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+      USE infotrac, ONLY: nqtot, niadv, tname
+      USE control_mod, ONLY: planet_type, nsplit_phys
+      USE write_field
+      USE cpdet_mod, only: t2tpot,tpot2t
+ 
+! used only for zonal averages
+      USE moyzon_mod
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       callrad         clef d'appel au rayonnement
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature (K/s)
+c        pdtsfi         tendency for the surface temperature
+c
+c        pdtrad         radiative tendencies  \  both input
+c        pfluxrad       radiative fluxes      /  and output
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "logic.h"
+
+      INTEGER ngridmx
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "iniprint.h"
+
+c    Arguments :
+c    -----------
+      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
+      REAL,INTENT(IN) :: jD_cur, jH_cur
+      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
+      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
+      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
+      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
+      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
+      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
+      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
+
+      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
+      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
+      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
+! commentaire SL: pdq ne sert que pour le calcul de pcvgq,
+! qui lui meme ne sert a rien dans la routine telle qu'elle est
+! ecrite, et que j'ai donc commente....
+      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
+      ! NB: pdq is only used to compute pcvgq which is in fact not used...
+
+      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
+      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
+      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
+      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
+
+      ! tendencies (in */s) from the physics
+      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
+      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
+      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
+      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
+      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
+
+#ifndef CPP_PARA
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq,iiq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
+! ADAPTATION GCM POUR CP(T)
+      REAL zteta(ngridmx,llm)
+      REAL zpk(ngridmx,llm)
+
+! RQ SL 13/10/10:
+! Ces calculs ne servent pas. 
+! Si necessaire, decommenter ces variables et les calculs...
+!      REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm)
+!      REAL pcvgt(ngridmx,llm), pcvgq(ngridmx,llm,2)
+
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
+      REAL zdpsrf(ngridmx)
+
+      REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm)
+      REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot)
+      REAL jH_cur_split,zdt_split
+      LOGICAL debut_split,lafin_split
+      INTEGER isplit
+
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+      save unskap
+
+      REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
+      
+      REAL SSUM
+
+      LOGICAL,SAVE :: firstcal=.true., debut=.true.
+!      REAL rdayvrai
+
+      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
+
+! For Titan only right now: 
+! to allow for 2D computation of microphys and chemistry
+      LOGICAL,save :: flag_moyzon
+      REAL,allocatable,save :: tmpvar(:,:)
+      REAL,allocatable,save :: tmpvarp1(:,:)
+      REAL,allocatable,save :: tmpvarbar(:)
+      REAL,allocatable,save :: tmpvarbarp1(:)
+      real :: zz1,zz2
+
+c-----------------------------------------------------------------------
+
+c    1. Initialisations :
+c    --------------------
+
+
+      IF ( firstcal )  THEN
+        debut = .TRUE.
+        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         write(lunout,*) 'STOP dans calfis'
+         write(lunout,*)
+     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         write(lunout,*) '  ngridmx  jjm   iim   '
+         write(lunout,*) ngridmx,jjm,iim
+         STOP
+        ENDIF
+
+        unskap   = 1./ kappa
+
+        flag_moyzon = .false.
+        if(moyzon_ch.or.moyzon_mu) then
+         flag_moyzon = .true.
+         allocate(tmpvar(iip1,llm))
+         allocate(tmpvarp1(iip1,llmp1))
+         allocate(tmpvarbar(llm))
+         allocate(tmpvarbarp1(llmp1))
+        endif
+
+        if (flag_moyzon) call moyzon_init(ngridmx,llm,nqtot)
+
+c----------------------------------------------
+c moyennes globales pour le profil de pression
+       if(planet_type.eq."titan".or.planet_type.eq."venus") then
+        ALLOCATE(plevmoy(llm+1))
+        ALLOCATE(playmoy(llm))
+        ALLOCATE(tmoy(llm))
+        ALLOCATE(tetamoy(llm))
+        ALLOCATE(pkmoy(llm))
+        ALLOCATE(phimoy(0:llm))
+        ALLOCATE(zlevmoy(llm+1))
+        ALLOCATE(zlaymoy(llm))
+        plevmoy=0.
+        do l=1,llmp1
+         do i=1,iip1
+          do j=1,jjp1
+            plevmoy(l)=plevmoy(l)+pp(i,j,l)/(iip1*jjp1)
+          enddo
+         enddo
+        enddo
+        tetamoy=0.
+        pkmoy=0.
+        phimoy=0.
+        do i=1,iip1
+         do j=1,jjp1
+            phimoy(0)=phimoy(0)+pphis(i,j)/(iip1*jjp1)
+         enddo
+        enddo
+        do l=1,llm
+         do i=1,iip1
+          do j=1,jjp1
+            tetamoy(l)=tetamoy(l)+pteta(i,j,l)/(iip1*jjp1)
+            pkmoy(l)=pkmoy(l)+ppk(i,j,l)/(iip1*jjp1)
+            phimoy(l)=phimoy(l)+pphi(i,j,l)/(iip1*jjp1)
+          enddo
+         enddo
+        enddo
+        playmoy(:) = preff * (pkmoy(:)/cpp) ** unskap
+        call tpot2t(llm,tetamoy,tmoy,pkmoy)
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+        zlaymoy(:) = g*rad*rad/(g*rad-phimoy(:))-rad
+        zlevmoy(1) = phimoy(0)/g
+        DO l=2,llm
+            zz1=(playmoy(l-1)+plevmoy(l))/(playmoy(l-1)-plevmoy(l))
+            zz2=(plevmoy(l)  +playmoy(l))/(plevmoy(l)  -playmoy(l))
+            zlevmoy(l)=(zz1*zlaymoy(l-1)+zz2*zlaymoy(l))/(zz1+zz2)
+        ENDDO
+        zlevmoy(llmp1)=zlaymoy(llm)+(zlaymoy(llm)-zlevmoy(llm))
+c-------------------
+c + lat index
+        allocate(klat(ngridmx))
+        klat=0
+        klat(1)  = 1
+        ig0  = 2
+        DO j = 2,jjm
+         do i=0,iim-1
+          klat(ig0+i) = j
+         enddo
+         ig0 = ig0+iim
+        ENDDO
+        klat(ngridmx)  = jjp1
+       endif   ! planet_type=titan
+c----------------------------------------------
+      ELSE
+        debut = .FALSE.
+      ENDIF ! of IF (firstcal)
+
+
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+c   42. pression intercouches et fonction d'Exner:
+
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+
+! ADAPTATION GCM POUR CP(T)
+      DO l = 1, llm
+        zpk(   1,l ) = ppk(1,1,l)
+        zteta( 1,l ) = pteta(1,1,l)
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zpk(   ig0,l ) = ppk(i,j,l)
+              zteta( ig0,l ) = pteta(i,j,l)
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zpk(   ngridmx,l ) = ppk(1,jjp1,l)
+        zteta( ngridmx,l ) = pteta(1,jjp1,l)
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+        zplev( 1,llmp1 ) = pp(1,1,llmp1)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,llmp1 ) = pp(i,j,llmp1)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,llmp1 ) = pp(1,jjp1,llmp1)
+
+      if (flag_moyzon) then
+        tmpvarp1(:,:) = pp(:,1,:)
+        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
+        zplevbar(1,:) = tmpvarbarp1
+        tmpvar(:,:) = ppk(:,1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zpkbar(1,:) = tmpvarbar
+        tmpvar(:,:) = pteta(:,1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        ztetabar(1,:) = tmpvarbar
+        call tpot2t(llm,ztetabar(1,:),ztfibar(1,:),zpkbar(1,:))
+        ig0 = 2
+         do j = 2, jjm
+          tmpvarp1(:,:) = pp(:,j,:)
+          call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
+          zplevbar(ig0,:) = tmpvarbarp1
+          tmpvar(:,:) = ppk(:,j,:)
+          call moyzon(llm,tmpvar,tmpvarbar)
+          zpkbar(ig0,:) = tmpvarbar
+          tmpvar(:,:) = pteta(:,j,:)
+          call moyzon(llm,tmpvar,tmpvarbar)
+          ztetabar(ig0,:) = tmpvarbar
+          call tpot2t(llm,ztetabar(ig0,:),ztfibar(ig0,:),zpkbar(ig0,:))
+          ig0 = ig0+1
+          do i=2,iim
+            zplevbar(ig0,:) = zplevbar(ig0-1,:)
+            zpkbar(ig0,:)   = zpkbar(ig0-1,:)
+            ztetabar(ig0,:) = ztetabar(ig0-1,:)
+            ztfibar(ig0,:)  = ztfibar(ig0-1,:)
+            ig0 = ig0+1
+          enddo
+         enddo
+        tmpvarp1(:,:) = pp(:,jjp1,:)
+        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
+        zplevbar(ngridmx,:) = tmpvarbarp1
+        tmpvar(:,:) = ppk(:,jjp1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zpkbar(ngridmx,:) = tmpvarbar
+        tmpvar(:,:) = pteta(:,jjp1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        ztetabar(ngridmx,:) = tmpvarbar
+        call tpot2t(llm,ztetabar(ngridmx,:),
+     .                  ztfibar(ngridmx,:),zpkbar(ngridmx,:))
+      endif
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+! ADAPTATION GCM POUR CP(T)
+         call tpot2t(ngridmx*llm,zteta,ztfi,zpk)
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+!         pcvgt(1,l)  =  pdteta(1,1,l) * pksurcp / pmasse(1,1,l)
+         ig0         = 2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+!              pcvgt(ig0,l)   = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+!         pcvgt(ig0,l)  = pdteta(1,jjp1,l) * pksurcp/ pmasse(1,jjp1,l)
+
+      ENDDO
+
+      if (flag_moyzon) then
+        zplaybar(:,:) = preff * (zpkbar(:,:)/cpp)**unskap
+      endif
+
+c   43.bis traceurs (tous intensifs) 
+c   ---------------
+
+      DO iq=1,nqtot
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO  ! boucle sur traceurs
+
+      if (flag_moyzon) then
+       DO iq=1,nqtot
+! RQ: REVOIR A QUOI CA SERT... ET VERIFIER...
+!       iiq=niadv(iq) 
+! en fait, iiq=iq...
+! FIN RQ
+        tmpvar(:,:) = pq(:,1,:,iq)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zqfibar(1,:,iq) = tmpvarbar
+        ig0 = 2
+         do j = 2, jjm
+          tmpvar(:,:) = pq(:,j,:,iq)
+          call moyzon(llm,tmpvar,tmpvarbar)
+          zqfibar(ig0,:,iq) = tmpvarbar
+          ig0 = ig0+1
+          do i=2,iim
+            zqfibar(ig0,:,iq) = zqfibar(ig0-1,:,iq)
+            ig0 = ig0+1
+          enddo
+         enddo
+        tmpvar(:,:) = pq(:,jjp1,:,iq)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zqfibar(ngridmx,:,iq) = tmpvarbar
+       ENDDO ! of DO iq=1,nqtot
+      endif
+
+! DEBUG
+!     do ig0=1,ngridmx
+!       write(*,'(6(e13.5,1x))') zqfibar(ig0,1,10),zqfi(ig0,1,10),
+!    .                         zqfibar(ig0,llm/2,10),zqfi(ig0,llm/2,10), 
+!    .                           zqfibar(ig0,llm,10),zqfi(ig0,llm,10) 
+!     enddo
+!     stop
+
+!-----------------
+! RQ SL 13/10/10:
+! Ces calculs ne servent pas. 
+! Si necessaire, decommenter ces variables et les calculs...
+!
+!   convergence dynamique pour les traceurs "EAU"
+! Earth-specific treatment of first 2 tracers (water)
+!      if (planet_type=="earth") then
+!       DO iq=1,2
+!        DO l=1,llm
+!           pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)
+!           ig0          = 2
+!           DO j=2,jjm
+!              DO i = 1, iim
+!                 pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
+!                 ig0             = ig0 + 1
+!              ENDDO
+!           ENDDO
+!           pcvgq(ig0,l,iq)= pdq(1,jjp1,l,iq) / pmasse(1,jjp1,l)
+!        ENDDO
+!       ENDDO
+!      endif ! of if (planet_type=="earth")
+!----------------
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+           zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+      if (flag_moyzon) then
+        tmpvar(:,1) = pphis(:,1)
+        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
+        zphisbar(1) = tmpvarbar(1)
+        tmpvar(:,:) = pphi(:,1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zphibar(1,:) = tmpvarbar
+        ig0 = 2
+         do j = 2, jjm
+          tmpvar(:,1) = pphis(:,j)
+          call moyzon(1,tmpvar(:,1),tmpvarbar(1))
+          zphisbar(ig0) = tmpvarbar(1)
+          tmpvar(:,:) = pphi(:,j,:)
+          call moyzon(llm,tmpvar,tmpvarbar)
+          zphibar(ig0,:) = tmpvarbar
+          ig0 = ig0+1
+          do i=2,iim
+            zphisbar(ig0)  = zphisbar(ig0-1)
+            zphibar(ig0,:) = zphibar(ig0-1,:)
+            ig0 = ig0+1
+          enddo
+         enddo
+        tmpvar(:,1) = pphis(:,jjp1)
+        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
+        zphisbar(ngridmx) = tmpvarbar(1)
+        tmpvar(:,:) = pphi(:,jjp1,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zphibar(ngridmx,:) = tmpvarbar
+      endif
+
+c   ....  Calcul de la vitesse  verticale  ( en Pa*m*s  ou Kg/s )  ....
+c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux 
+c    de masse est calclue dans advtrac.F  
+c      DO l=1,llm
+c        pvervel(1,l)=pw(1,1,l) * g /apoln
+c        ig0=2
+c       DO j=2,jjm
+c           DO i = 1, iim
+c              pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j)
+c              ig0 = ig0 + 1
+c           ENDDO
+c       ENDDO
+c        pvervel(ig0,l)=pw(1,jjp1,l) * g /apols
+c      ENDDO
+
+c
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+!            pcvgu(ig0+1,l)= 0.5 * 
+!     $      ( pducov(iim,j,l)/cu(iim,j) + pducov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+!               pcvgu(ig0+i,l)= 0.5 *
+!     $         ( pducov(i-1,j,l)/cu(i-1,j) + pducov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+c               pcvgv(ig0+i,l)= 0.5 *
+c     $         ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+!         pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+!         pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+!         pcvgu(ngridmx,l) = SSUM(iim,zcosbis,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+!         pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi
+
+      ENDDO
+c
+c On change de grille, dynamique vers physiq, pour le flux de masse verticale
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi)
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+! Appel de la physique: pose probleme quand on tourne 
+! SANS physique, car physiq.F est dans le repertoire phy[]... 
+! Il faut une cle CPP_PHYS
+
+! Le fait que les arguments de physiq soient differents selon les planetes 
+! ne pose pas de probleme a priori.
+
+!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+      zdt_split=dtphys/nsplit_phys
+      zdufic(:,:)=0.
+      zdvfic(:,:)=0.
+      zdtfic(:,:)=0.
+      zdqfic(:,:,:)=0.
+
+#ifdef CPP_PHYS
+
+      do isplit=1,nsplit_phys
+
+         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
+         debut_split=debut.and.isplit==1
+         lafin_split=lafin.and.isplit==nsplit_phys
+
+      if (planet_type.eq."earth") then
+         CALL physiq (ngridmx,
+     .             llm,
+     .             debut_split,
+     .             lafin_split,
+     .             jD_cur,
+     .             jH_cur_split,
+     .             zdt_split,
+     .             zplev,
+     .             zplay,
+     .             zphi,
+     .             zphis,
+     .             presnivs,
+     .             zufi,
+     .             zvfi,
+     .             ztfi,
+     .             zqfi,
+     .             flxwfi,
+     .             zdufi,
+     .             zdvfi,
+     .             zdtfi,
+     .             zdqfi,
+     .             zdpsrf,
+     .             pducov)
+
+      else if ( planet_type=="generic" ) then
+
+         CALL physiq (ngridmx,     !! ngrid
+     .             llm,            !! nlayer
+     .             nqtot,          !! nq
+     .             tname,          !! tracer names from dynamical core (given in infotrac)
+     .             debut_split,    !! firstcall 
+     .             lafin_split,    !! lastcall
+     .             jD_cur,         !! pday. see leapfrog
+     .             jH_cur_split,   !! ptime "fraction of day"
+     .             zdt_split,      !! ptimestep
+     .             zplev,          !! pplev
+     .             zplay,          !! pplay
+     .             zphi,           !! pphi
+     .             zufi,           !! pu
+     .             zvfi,           !! pv
+     .             ztfi,           !! pt
+     .             zqfi,           !! pq
+     .             flxwfi,         !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
+     .             zdufi,          !! pdu
+     .             zdvfi,          !! pdv
+     .             zdtfi,          !! pdt
+     .             zdqfi,          !! pdq
+     .             zdpsrf,         !! pdpsrf
+     .             tracerdyn)      !! tracerdyn <-- utilite ???
+
+      else if ( planet_type=="mars" ) then
+
+        CALL physiq (ngridmx,    ! ngrid
+     .             llm,          ! nlayer
+     .             nqtot,        ! nq
+     .             debut_split,  ! firstcall
+     .             lafin_split,  ! lastcall
+     .             jD_cur,       ! pday
+     .             jH_cur_split, ! ptime
+     .             zdt_split,    ! ptimestep
+     .             zplev,        ! pplev
+     .             zplay,        ! pplay
+     .             zphi,         ! pphi
+     .             zufi,         ! pu
+     .             zvfi,         ! pv
+     .             ztfi,         ! pt
+     .             zqfi,         ! pq
+     .             flxwfi,       ! pw
+     .             zdufi,        ! pdu
+     .             zdvfi,        ! pdv
+     .             zdtfi,        ! pdt
+     .             zdqfi,        ! pdq
+     .             zdpsrf,       ! pdpsrf
+     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
+
+      else if ((planet_type=="titan").or.(planet_type=="venus")) then
+
+         CALL physiq (ngridmx,
+     .             llm,
+     .             nqtot,
+     .             debut_split,
+     .             lafin_split,
+     .             jD_cur,
+     .             jH_cur_split,
+     .             zdt_split,
+     .             zplev,
+     .             zplay,
+     .             zpk,
+     .             zphi,
+     .             zphis,
+     .             presnivs,
+     .             zufi,
+     .             zvfi,
+     .             ztfi,
+     .             zqfi,
+     .             flxwfi,
+     .             zdufi,
+     .             zdvfi,
+     .             zdtfi,
+     .             zdqfi,
+     .             zdpsrf)
+
+      else ! unknown "planet_type"
+
+        write(lunout,*) "calfis_p: error, unknown planet_type: ",
+     &                  trim(planet_type)
+        stop
+
+      endif ! planet_type
+
+         zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
+         zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split
+         ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split
+         zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split
+
+         zdufic(:,:)=zdufic(:,:)+zdufi(:,:)
+         zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:)
+         zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:)
+         zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
+
+      enddo ! of do isplit=1,nsplit_phys
+
+! ATTENTION...
+      if (flag_moyzon.and.(nsplit_phys.ne.1)) then
+       print*,"WARNING ! flag_moyzon + nsplit_phys"
+       print*,"zqfibar n'est pas implemente au cours des iterations"
+       print*,"Donc a revoir..."
+       stop
+      endif
+
+#endif
+! #endif of #ifdef CPP_PHYS
+
+      zdufi(:,:)=zdufic(:,:)/nsplit_phys
+      zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
+      zdtfi(:,:)=zdtfic(:,:)/nsplit_phys
+      zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
+
+
+500   CONTINUE
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+c   62. enthalpie potentielle
+c   ---------------------
+
+! ADAPTATION GCM POUR CP(T)
+      call t2tpot(ngridmx*llm,ztfi,zteta,zpk)
+
+         DO i=1,iip1
+      pdhfi(i,1,:) = (zteta(1,:) - pteta(i,1,:))/dtphys
+      pdhfi(i,jjp1,:) = (zteta(ngridmx,:) - pteta(i,jjp1,:))/dtphys
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+      pdhfi(i,j,:) = (zteta(ig0+i,:) - pteta(i,j,:))/dtphys
+            ENDDO
+               pdhfi(iip1,j,:) =  pdhfi(1,j,:)
+         ENDDO
+
+
+c   62. humidite specifique
+c   ---------------------
+! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
+!      DO iq=1,nqtot
+!         DO l=1,llm
+!            DO i=1,iip1
+!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+!               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+!            ENDDO
+!            DO j=2,jjm
+!               ig0=1+(j-2)*iim
+!               DO i=1,iim
+!                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+!               ENDDO
+!               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+!            ENDDO
+!         ENDDO
+!      ENDDO
+
+c   63. traceurs (tous en intensifs)
+c   ------------
+C     initialisation des tendances
+      pdqfi(:,:,:,:)=0.
+C
+       DO iq=1,nqtot
+         iiq=niadv(iq)
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iiq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iiq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iiq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+       ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+ 
+      firstcal = .FALSE.
+
+#endif
+! of #ifndef CPP_PARA
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis_p.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/calfis_p.F	(revision 1403)
@@ -0,0 +1,1444 @@
+!
+! $Id: calfis_p.F 1407 2010-07-07 10:31:52Z fairhead $
+!
+C
+C
+      SUBROUTINE calfis_p(lafin,
+     $                  jD_cur, jH_cur,
+     $                  pucov,
+     $                  pvcov,
+     $                  pteta,
+     $                  pq,
+     $                  pmasse,
+     $                  pps,
+     $                  pp,
+     $                  ppk,
+     $                  pphis,
+     $                  pphi,
+     $                  pducov,
+     $                  pdvcov,
+     $                  pdteta,
+     $                  pdq,
+     $                  flxw,
+     $                  pdufi,
+     $                  pdvfi,
+     $                  pdhfi,
+     $                  pdqfi,
+     $                  pdpsfi)
+#ifdef CPP_PHYS
+! Ehouarn: if using (parallelized) physics
+      USE dimphy
+      USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root 
+      USE mod_interface_dyn_phys
+!      USE IOPHY
+#endif
+#ifdef CPP_PARA
+      USE parallel_lmdz, ONLY : omp_chunk, using_mpi, AllGather_Field
+      USE Write_Field
+      Use Write_field_p
+      USE Times
+      USE cpdet_mod, only: tpot2t_p, t2tpot_p
+! used only for zonal averages
+      USE moyzon_mod
+#endif
+      USE infotrac, ONLY: nqtot, niadv, tname
+      USE control_mod, ONLY: planet_type, nsplit_phys
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       callrad         clef d'appel au rayonnement
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature (K/s)
+c        pdtsfi         tendency for the surface temperature
+c
+c        pdtrad         radiative tendencies  \  both input
+c        pfluxrad       radiative fluxes      /  and output
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "logic.h"
+
+      INTEGER ngridmx
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "iniprint.h"
+#ifdef CPP_MPI
+      include 'mpif.h'
+#endif
+c    Arguments :
+c    -----------
+      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
+      REAL,INTENT(IN) :: jD_cur, jH_cur
+      REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
+      REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
+      REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
+      REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
+      REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
+      REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
+      REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
+
+      REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
+      REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
+      REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
+! commentaire SL: pdq ne sert que pour le calcul de pcvgq,
+! qui lui meme ne sert a rien dans la routine telle qu'elle est
+! ecrite, et que j'ai donc commente....
+      REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
+      ! NB: pdq is only used to compute pcvgq which is in fact not used...
+
+      REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
+      REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
+      REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
+      REAL,INTENT(IN) :: flxw(iip1,jjp1,llm)  ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
+
+      ! tendencies (in */s) from the physics
+      REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
+      REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
+      REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
+      REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
+      REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
+
+#ifdef CPP_PARA
+#ifdef CPP_PHYS
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq,iiq
+      REAL,ALLOCATABLE,SAVE :: zpsrf(:)
+      REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
+      REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
+
+      REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
+      REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
+! ADAPTATION GCM POUR CP(T)
+      REAL,ALLOCATABLE,SAVE :: zteta(:,:)
+      REAL,ALLOCATABLE,SAVE ::  zpk(:,:)
+
+! Ces calculs ne servent pas. 
+! Si necessaire, decommenter ces variables et les calculs...
+!      REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
+!      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
+c
+      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
+      REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
+      REAL,SAVE,ALLOCATABLE ::  flxwfi(:,:)     ! Flux de masse verticale sur la grille physiq
+
+      REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zpk_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zphis_omp(:)
+      REAL,ALLOCATABLE,SAVE :: presnivs_omp(:)
+      REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 
+      REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
+      REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:)
+      REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:)
+      REAL,SAVE,ALLOCATABLE ::  flxwfi_omp(:,:)     ! Flux de masse verticale sur la grille physiq
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Introduction du splitting (FH)
+! Question pour Yann :
+! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent
+! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
+! soit allocatable (plutot par exemple que de passer une dimension
+! dépendant du process en argument des routines) et que, du coup,
+! le SAVE évite d'avoir à refaire l'allocation à chaque appel.
+! Tu confirmes ?
+! J'ai suivi le même principe pour les zdufic_omp
+! Mais c'est surement bien que tu controles.
+! 
+
+      REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:)
+      REAL jH_cur_split,zdt_split
+      LOGICAL debut_split,lafin_split
+      INTEGER isplit
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp,
+c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
+c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
+c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp,
+c$OMP+                 zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)       
+
+      LOGICAL,SAVE :: first_omp=.true.
+c$OMP THREADPRIVATE(first_omp)
+      
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+      save unskap
+
+      REAL SSUM
+
+      LOGICAL,SAVE :: firstcal=.true., debut=.true.
+c$OMP THREADPRIVATE(firstcal,debut)
+      
+      REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
+      INTEGER :: ierr
+#ifdef CPP_MPI
+      INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
+#else
+      INTEGER,dimension(1,4) :: Status
+#endif
+      INTEGER, dimension(4) :: Req
+      REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
+      integer :: k,kstart,kend
+      INTEGER :: offset  
+
+      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
+
+! For Titan only right now: 
+! to allow for 2D computation of microphys and chemistry
+      LOGICAL,save :: flag_moyzon
+      REAL,allocatable,save :: tmpvar(:,:)
+      REAL,allocatable,save :: tmpvarp1(:,:)
+      REAL,allocatable,save :: tmpvarbar(:)
+      REAL,allocatable,save :: tmpvarbarp1(:)
+      real :: zz1,zz2
+
+c-----------------------------------------------------------------------
+
+c    1. Initialisations :
+c    --------------------
+
+
+      klon=klon_mpi
+      
+      IF ( firstcal )  THEN
+        debut = .TRUE.
+        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         write(lunout,*) 'STOP dans calfis'
+         write(lunout,*) 
+     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         write(lunout,*) '  ngridmx  jjm   iim   '
+         write(lunout,*) ngridmx,jjm,iim
+         STOP
+        ENDIF
+
+        unskap   = 1./ kappa
+
+c$OMP MASTER
+        flag_moyzon = .false.
+        if(moyzon_ch.or.moyzon_mu) then
+         flag_moyzon = .true.
+         allocate(tmpvar(iip1,llm))
+         allocate(tmpvarp1(iip1,llmp1))
+         allocate(tmpvarbar(llm))
+         allocate(tmpvarbarp1(llmp1))
+        endif
+
+      ALLOCATE(zpsrf(klon))
+      ALLOCATE(zplev(klon,llm+1),zplay(klon,llm))
+      ALLOCATE(zphi(klon,llm),zphis(klon))
+      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
+      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
+!      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
+!      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
+      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
+      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
+      ALLOCATE(zdpsrf(klon))
+      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
+      ALLOCATE(flxwfi(klon,llm))
+! ADAPTATION GCM POUR CP(T)
+      ALLOCATE(zteta(klon,llm))
+      ALLOCATE(zpk(klon,llm))
+
+      ! zonal means. horizontal dimension should be iip1
+      if (flag_moyzon) call moyzon_init(klon,llm,nqtot)
+
+c------------------------------------------------------------------
+c moyennes globales pour les profils de pression et de temperature
+      if(planet_type.eq."titan".or.planet_type.eq."venus") then
+        call AllGather_Field(pp,iip1*jjp1,llmp1)
+        call AllGather_Field(pteta,iip1*jjp1,llm)
+        call AllGather_Field(ppk,iip1*jjp1,llm)
+        call AllGather_Field(pphi,iip1*jjp1,llm)
+        call AllGather_Field(pphis,iip1*jjp1,1)
+        ALLOCATE(plevmoy(llm+1))
+        ALLOCATE(playmoy(llm))
+        ALLOCATE(tmoy(llm))
+        ALLOCATE(tetamoy(llm))
+        ALLOCATE(pkmoy(llm))
+        ALLOCATE(phimoy(0:llm))
+        ALLOCATE(zlevmoy(llm+1))
+        ALLOCATE(zlaymoy(llm))
+        plevmoy=0.
+        do l=1,llmp1
+         do i=1,iip1
+          do j=1,jjp1
+            plevmoy(l)=plevmoy(l)+pp(i,j,l)/(iip1*jjp1)
+          enddo
+         enddo
+        enddo
+        tetamoy=0.
+        pkmoy=0.
+        phimoy=0.
+        do i=1,iip1
+         do j=1,jjp1
+            phimoy(0)=phimoy(0)+pphis(i,j)/(iip1*jjp1)
+         enddo
+        enddo
+        do l=1,llm
+         do i=1,iip1
+          do j=1,jjp1
+            tetamoy(l)=tetamoy(l)+pteta(i,j,l)/(iip1*jjp1)
+            pkmoy(l)=pkmoy(l)+ppk(i,j,l)/(iip1*jjp1)
+            phimoy(l)=phimoy(l)+pphi(i,j,l)/(iip1*jjp1)
+          enddo
+         enddo
+        enddo
+        playmoy(:) = preff * (pkmoy(:)/cpp) ** unskap
+        call tpot2t_p(1,llm,tetamoy,tmoy,pkmoy)
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+        zlaymoy(:) = g*rad*rad/(g*rad-phimoy(:))-rad
+        zlevmoy(1) = phimoy(0)/g
+        DO l=2,llm
+            zz1=(playmoy(l-1)+plevmoy(l))/(playmoy(l-1)-plevmoy(l))
+            zz2=(plevmoy(l)  +playmoy(l))/(plevmoy(l)  -playmoy(l))
+            zlevmoy(l)=(zz1*zlaymoy(l-1)+zz2*zlaymoy(l))/(zz1+zz2)
+        ENDDO
+        zlevmoy(llmp1)=zlaymoy(llm)+(zlaymoy(llm)-zlevmoy(llm))
+c-------------------
+c + lat index
+        allocate(klat(klon))
+        do ig0=1,klon
+          j=index_j(ig0)
+          klat(ig0)=j
+        enddo
+      endif   ! planet_type=titan
+c------------------------------------------------------------------
+
+c$OMP END MASTER
+c$OMP BARRIER	  
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+c$OMP MASTER
+      call start_timer(timer_physic)
+c$OMP END MASTER
+
+c$OMP MASTER             
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+      do ig0=1,klon
+        i=index_i(ig0)
+        j=index_j(ig0)
+        zpsrf(ig0)=pps(i,j)
+      enddo
+c$OMP END MASTER
+
+
+c   42. pression intercouches et fonction d'Exner:
+
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+
+c      print *,omp_rank,'klon--->',klon
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l = 1, llmp1
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+        do ig0=1,klon
+          i=index_i(ig0)
+          j=index_j(ig0)
+          zplev( ig0,l ) = pp(i,j,l)
+        enddo
+      ENDDO
+c$OMP END DO NOWAIT
+      if (flag_moyzon) then
+        call AllGather_Field(pp,iip1*jjp1,llmp1)
+        j=index_j(1)
+        tmpvarp1(:,:) = pp(:,j,:)
+        call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
+        zplevbar_mpi(1,:) = tmpvarbarp1
+        do ig0=2,klon
+          j=index_j(ig0)
+          if (j.ne.index_j(ig0-1)) then
+            tmpvarp1(:,:) = pp(:,j,:)
+            call moyzon(llmp1,tmpvarp1,tmpvarbarp1)
+            zplevbar_mpi(ig0,:) = tmpvarbarp1
+          else
+            zplevbar_mpi(ig0,:) = zplevbar_mpi(ig0-1,:)
+          endif
+        enddo
+      endif
+
+! ADAPTATION GCM POUR CP(T)
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+        do ig0=1,klon
+          i=index_i(ig0)
+          j=index_j(ig0)
+          zpk(ig0,l)=ppk(i,j,l)
+          zteta(ig0,l)=pteta(i,j,l)
+        enddo
+      ENDDO
+c$OMP END DO NOWAIT
+      if (flag_moyzon) then
+        call AllGather_Field(pteta,iip1*jjp1,llm)
+        call AllGather_Field(ppk,iip1*jjp1,llm)
+        j=index_j(1)
+        tmpvar(:,:) = pteta(:,j,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        ztetabar_mpi(1,:) = tmpvarbar
+        tmpvar(:,:) = ppk(:,j,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zpkbar_mpi(1,:) = tmpvarbar
+        call tpot2t_p(1,llm,ztetabar_mpi(1,:),ztfibar_mpi(1,:),
+     &                      zpkbar_mpi(1,:))
+        do ig0=2,klon
+          j=index_j(ig0)
+          if (j.ne.index_j(ig0-1)) then
+            tmpvar(:,:) = pteta(:,j,:)
+            call moyzon(llm,tmpvar,tmpvarbar)
+            ztetabar_mpi(ig0,:) = tmpvarbar
+            tmpvar(:,:) = ppk(:,j,:)
+            call moyzon(llm,tmpvar,tmpvarbar)
+            zpkbar_mpi(ig0,:) = tmpvarbar
+            call tpot2t_p(1,llm,ztetabar_mpi(ig0,:),ztfibar_mpi(ig0,:),
+     &                          zpkbar_mpi(ig0,:))
+          else
+            zpkbar_mpi(ig0,:)   = zpkbar_mpi(ig0-1,:)
+            ztetabar_mpi(ig0,:) = ztetabar_mpi(ig0-1,:)
+            ztfibar_mpi(ig0,:)  = ztfibar_mpi(ig0-1,:)
+          endif
+        enddo
+      endif
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+! ADAPTATION GCM POUR CP(T)
+         call tpot2t_p(klon,llm,zteta,ztfi,zpk)
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+        do ig0=1,klon
+          i=index_i(ig0)
+          j=index_j(ig0)
+          pksurcp        = ppk(i,j,l) / cpp
+          zplay(ig0,l)   = preff * pksurcp ** unskap
+        enddo
+      ENDDO
+c$OMP END DO NOWAIT
+      if (flag_moyzon) then
+        zplaybar_mpi(:,:) = preff * (zpkbar_mpi(:,:)/cpp)**unskap
+      endif
+
+c   43.bis traceurs (tous intensifs)
+c   ---------------
+
+      DO iq=1,nqtot
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+         DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+           do ig0=1,klon
+             i=index_i(ig0)
+             j=index_j(ig0)
+             zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+           enddo
+         ENDDO
+c$OMP END DO NOWAIT	 
+      ENDDO ! of DO iq=1,nqtot
+      if (flag_moyzon) then
+       DO iq=1,nqtot
+         call AllGather_Field(pq(:,:,:,iq),iip1*jjp1,llm)
+         j=index_j(1)
+         tmpvar(:,:) = pq(:,j,:,iq)
+         call moyzon(llm,tmpvar,tmpvarbar)
+         zqfibar_mpi(1,:,iq) = tmpvarbar
+         do ig0=2,klon
+          j=index_j(ig0)
+          if (j.ne.index_j(ig0-1)) then
+            tmpvar(:,:) = pq(:,j,:,iq)
+            call moyzon(llm,tmpvar,tmpvarbar)
+            zqfibar_mpi(ig0,:,iq) = tmpvarbar
+          else
+            zqfibar_mpi(ig0,:,iq) = zqfibar_mpi(ig0-1,:,iq)
+          endif
+        enddo
+       ENDDO ! of DO iq=1,nqtot
+      endif
+
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
+
+      CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
+
+c$OMP BARRIER
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+	 DO ig=1,klon
+	   zphi(ig,l)=zphi(ig,l)-zphis(ig)
+	 ENDDO
+      ENDDO
+c$OMP END DO NOWAIT
+      
+      if (flag_moyzon) then
+        call AllGather_Field(pphis,iip1*jjp1,1)
+        call AllGather_Field(pphi,iip1*jjp1,llm)
+        j=index_j(1)
+        tmpvar(:,1) = pphis(:,j)
+        call moyzon(1,tmpvar(:,1),tmpvarbar(1))
+        zphisbar_mpi(1) = tmpvarbar(1)
+        tmpvar(:,:) = pphi(:,j,:)
+        call moyzon(llm,tmpvar,tmpvarbar)
+        zphibar_mpi(1,:) = tmpvarbar-zphisbar_mpi(1)
+        do ig0=2,klon
+          j=index_j(ig0)
+          if (j.ne.index_j(ig0-1)) then
+            tmpvar(:,1) = pphis(:,j)
+            call moyzon(1,tmpvar(:,1),tmpvarbar(1))
+            zphisbar_mpi(ig0) = tmpvarbar(1)
+            tmpvar(:,:) = pphi(:,j,:)
+            call moyzon(llm,tmpvar,tmpvarbar)
+            zphibar_mpi(ig0,:) = tmpvarbar-zphisbar_mpi(ig0)
+          else
+            zphisbar_mpi(ig0)  = zphisbar_mpi(ig0-1)
+            zphibar_mpi(ig0,:) = zphibar_mpi(ig0-1,:)
+          endif
+        enddo
+      endif
+
+c
+c   45. champ u:
+c   ------------
+
+      kstart=1
+      kend=klon
+      
+      if (is_north_pole) kstart=2
+      if (is_south_pole) kend=klon-1
+      
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+!CDIR SPARSE
+        do ig0=kstart,kend
+          i=index_i(ig0)
+          j=index_j(ig0)
+          if (i==1) then
+            zufi(ig0,l)= 0.5 *(  pucov(iim,j,l)/cu(iim,j)
+     $                         + pucov(1,j,l)/cu(1,j) )
+          else
+            zufi(ig0,l)= 0.5*(  pucov(i-1,j,l)/cu(i-1,j) 
+     $                       + pucov(i,j,l)/cu(i,j) )
+          endif
+        enddo
+      ENDDO
+c$OMP END DO NOWAIT
+
+c   46.champ v:
+c   -----------
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+        DO ig0=kstart,kend
+          i=index_i(ig0)
+          j=index_j(ig0)
+          zvfi(ig0,l)= 0.5 *(  pvcov(i,j-1,l)/cv(i,j-1) 
+     $                       + pvcov(i,j,l)/cv(i,j) )
+    
+         ENDDO
+      ENDDO
+c$OMP END DO NOWAIT
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      if (is_north_pole) then
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+        DO l=1,llm
+
+           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+           DO i=2,iim
+              z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+           ENDDO
+  
+           DO i=1,iim
+              zcos(i)   = COS(rlonv(i))*z1(i)
+              zsin(i)   = SIN(rlonv(i))*z1(i)
+           ENDDO
+  
+           zufi(1,l)  = SSUM(iim,zcos,1)/pi
+           zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+  
+        ENDDO
+c$OMP END DO NOWAIT      
+      endif
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      if (is_south_pole) then
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+        DO l=1,llm
+  
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+           DO i=2,iim
+             z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+	   ENDDO
+  
+           DO i=1,iim
+              zcos(i)    = COS(rlonv(i))*z1(i)
+              zsin(i)    = SIN(rlonv(i))*z1(i)
+	   ENDDO
+  
+           zufi(klon,l)  = SSUM(iim,zcos,1)/pi
+           zvfi(klon,l)  = SSUM(iim,zsin,1)/pi
+        ENDDO
+c$OMP END DO NOWAIT       
+      endif
+
+c On change de grille, dynamique vers physiq, pour le flux de masse verticale
+      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+! Appel de la physique: pose probleme quand on tourne 
+! SANS physique, car physiq.F est dans le repertoire phy[]... 
+! Il faut une cle CPP_PHYS
+
+! Le fait que les arguments de physiq soient differents selon les planetes 
+! ne pose pas de probleme a priori.
+
+
+c$OMP BARRIER
+      if (first_omp) then
+        klon=klon_omp
+
+        allocate(zplev_omp(klon,llm+1))
+        allocate(zplay_omp(klon,llm))
+        allocate(zpk_omp(klon,llm))
+        allocate(zphi_omp(klon,llm))
+        allocate(zphis_omp(klon))
+        allocate(presnivs_omp(llm))
+        allocate(zufi_omp(klon,llm))
+        allocate(zvfi_omp(klon,llm))
+        allocate(ztfi_omp(klon,llm))
+        allocate(zqfi_omp(klon,llm,nqtot))
+        allocate(zdufi_omp(klon,llm))
+        allocate(zdvfi_omp(klon,llm))
+        allocate(zdtfi_omp(klon,llm))
+        allocate(zdqfi_omp(klon,llm,nqtot))
+        allocate(zdufic_omp(klon,llm))
+        allocate(zdvfic_omp(klon,llm))
+        allocate(zdtfic_omp(klon,llm))
+        allocate(zdqfic_omp(klon,llm,nqtot))
+        allocate(zdpsrf_omp(klon))
+        allocate(flxwfi_omp(klon,llm))
+
+        if (flag_moyzon) call moyzon_init_omp(klon,llm,nqtot)
+
+	first_omp=.false.
+      endif
+       
+	   
+      klon=klon_omp
+      offset=klon_omp_begin-1
+      
+      do l=1,llm+1
+        do i=1,klon
+          zplev_omp(i,l)=zplev(offset+i,l)
+	enddo 
+      enddo
+	  
+       do l=1,llm
+        do i=1,klon  
+	  zplay_omp(i,l)=zplay(offset+i,l)
+	enddo 
+      enddo
+	
+       do l=1,llm
+        do i=1,klon  
+	  zpk_omp(i,l)=zpk(offset+i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zphi_omp(i,l)=zphi(offset+i,l)
+	enddo 
+      enddo
+	
+      do i=1,klon
+	zphis_omp(i)=zphis(offset+i)
+      enddo 
+     
+	
+      do l=1,llm
+        presnivs_omp(l)=presnivs(l)
+      enddo 
+	
+      do l=1,llm
+        do i=1,klon
+	  zufi_omp(i,l)=zufi(offset+i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zvfi_omp(i,l)=zvfi(offset+i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  ztfi_omp(i,l)=ztfi(offset+i,l)
+	enddo 
+      enddo
+	
+      do iq=1,nqtot
+        do l=1,llm
+          do i=1,klon
+            zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
+	  enddo
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zdufi_omp(i,l)=zdufi(offset+i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zdvfi_omp(i,l)=zdvfi(offset+i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+          zdtfi_omp(i,l)=zdtfi(offset+i,l)
+	enddo 
+      enddo
+	
+      do iq=1,nqtot
+        do l=1,llm
+          do i=1,klon
+	    zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
+	  enddo 
+        enddo
+      enddo
+      	
+      do i=1,klon
+	zdpsrf_omp(i)=zdpsrf(offset+i)
+      enddo 
+
+      do l=1,llm
+        do i=1,klon
+          flxwfi_omp(i,l)=flxwfi(offset+i,l)
+	enddo 
+      enddo
+
+      if (flag_moyzon) then
+       do l=1,llm+1
+        do i=1,klon
+          zplevbar(i,l)=zplevbar_mpi(offset+i,l)
+	enddo 
+       enddo
+	  
+       do l=1,llm
+        do i=1,klon  
+	  zplaybar(i,l)=zplaybar_mpi(offset+i,l)
+	enddo 
+       enddo
+	
+       do l=1,llm
+        do i=1,klon
+	  zphibar(i,l)=zphibar_mpi(offset+i,l)
+	enddo 
+       enddo
+		
+      do i=1,klon
+	zphisbar(i)=zphisbar_mpi(offset+i)
+      enddo 
+     
+      do l=1,llm
+        do i=1,klon
+	  ztfibar(i,l)=ztfibar_mpi(offset+i,l)
+	enddo 
+      enddo
+	
+      do iq=1,nqtot
+        do l=1,llm
+          do i=1,klon
+            zqfibar(i,l,iq)=zqfibar_mpi(offset+i,l,iq)
+	  enddo
+	enddo 
+       enddo
+      endif
+
+      
+c$OMP BARRIER
+
+!$OMP MASTER
+!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+!$OMP END MASTER
+      zdt_split=dtphys/nsplit_phys
+      zdufic_omp(:,:)=0.
+      zdvfic_omp(:,:)=0.
+      zdtfic_omp(:,:)=0.
+      zdqfic_omp(:,:,:)=0.
+
+#ifdef CPP_PHYS
+      do isplit=1,nsplit_phys
+
+         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
+         debut_split=debut.and.isplit==1
+         lafin_split=lafin.and.isplit==nsplit_phys
+
+
+      if (planet_type=="earth") then
+        CALL physiq (klon,
+     .             llm,
+     .             debut_split,
+     .             lafin_split,
+     .             jD_cur,
+     .             jH_cur_split,
+     .             zdt_split,
+     .             zplev_omp,
+     .             zplay_omp,
+     .             zphi_omp,
+     .             zphis_omp,
+     .             presnivs_omp,
+     .             zufi_omp,
+     .             zvfi_omp,
+     .             ztfi_omp,
+     .             zqfi_omp,
+     .             flxwfi_omp,
+     .             zdufi_omp,
+     .             zdvfi_omp,
+     .             zdtfi_omp,
+     .             zdqfi_omp,
+     .             zdpsrf_omp,
+     .             pducov)
+
+      else if ( planet_type=="generic" ) then
+
+      CALL physiq (klon,     !! ngrid
+     .             llm,            !! nlayer
+     .             nqtot,          !! nq
+     .             tname,          !! tracer names from dynamical core (given in infotrac)
+     .             debut_split,    !! firstcall 
+     .             lafin_split,    !! lastcall
+     .             jD_cur,         !! pday. see leapfrog_p 
+     .             jH_cur_split,   !! ptime "fraction of day"
+     .             zdt_split,      !! ptimestep
+     .             zplev_omp,  !! pplev
+     .             zplay_omp,  !! pplay
+     .             zphi_omp,   !! pphi
+     .             zufi_omp,   !! pu
+     .             zvfi_omp,   !! pv
+     .             ztfi_omp,   !! pt
+     .             zqfi_omp,   !! pq
+     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
+     .             zdufi_omp,  !! pdu
+     .             zdvfi_omp,  !! pdv
+     .             zdtfi_omp,  !! pdt
+     .             zdqfi_omp,  !! pdq
+     .             zdpsrf_omp, !! pdpsrf
+     .             tracerdyn)      !! tracerdyn <-- utilite ???
+
+      else if ( planet_type=="mars" ) then
+
+        CALL physiq (klon,       ! ngrid
+     .             llm,          ! nlayer
+     .             nqtot,        ! nq
+     .             debut_split,  ! firstcall
+     .             lafin_split,  ! lastcall
+     .             jD_cur,       ! pday
+     .             jH_cur_split, ! ptime
+     .             zdt_split,    ! ptimestep
+     .             zplev_omp,    ! pplev
+     .             zplay_omp,    ! pplay
+     .             zphi_omp,     ! pphi
+     .             zufi_omp,     ! pu
+     .             zvfi_omp,     ! pv
+     .             ztfi_omp,     ! pt
+     .             zqfi_omp,     ! pq
+     .             flxwfi_omp,   ! pw
+     .             zdufi_omp,    ! pdu
+     .             zdvfi_omp,    ! pdv
+     .             zdtfi_omp,    ! pdt
+     .             zdqfi_omp,    ! pdq
+     .             zdpsrf_omp,   ! pdpsrf
+     .             tracerdyn)    ! tracerdyn (somewhat obsolete)
+
+      else if ((planet_type=="titan").or.(planet_type=="venus")) then
+
+        CALL physiq (klon,
+     .             llm,
+     .             nqtot,
+     .             debut_split,
+     .             lafin_split,
+     .             jD_cur,
+     .             jH_cur_split,
+     .             zdt_split,
+     .             zplev_omp,
+     .             zplay_omp,
+     .             zpk_omp,
+     .             zphi_omp,
+     .             zphis_omp,
+     .             presnivs_omp,
+     .             zufi_omp,
+     .             zvfi_omp,
+     .             ztfi_omp,
+     .             zqfi_omp,
+     .             flxwfi_omp,
+     .             zdufi_omp,
+     .             zdvfi_omp,
+     .             zdtfi_omp,
+     .             zdqfi_omp,
+     .             zdpsrf_omp)
+
+      else ! unknown "planet_type"
+
+        write(lunout,*) "calfis_p: error, unknown planet_type: ",
+     &                  trim(planet_type)
+        stop
+
+      endif ! planet_type
+         zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
+         zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
+         ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
+         zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
+
+         zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
+         zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
+         zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
+         zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
+
+      enddo
+
+#endif
+! of #ifdef CPP_PHYS
+
+      zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
+      zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
+      zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
+      zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
+
+c$OMP BARRIER
+
+      do l=1,llm+1
+        do i=1,klon
+          zplev(offset+i,l)=zplev_omp(i,l)
+	enddo 
+      enddo
+	  
+       do l=1,llm
+        do i=1,klon  
+	  zplay(offset+i,l)=zplay_omp(i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zphi(offset+i,l)=zphi_omp(i,l)
+	enddo 
+      enddo
+	
+
+      do i=1,klon
+	zphis(offset+i)=zphis_omp(i)
+      enddo 
+     
+	
+      do l=1,llm
+        presnivs(l)=presnivs_omp(l)
+      enddo 
+	
+      do l=1,llm
+        do i=1,klon
+	  zufi(offset+i,l)=zufi_omp(i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zvfi(offset+i,l)=zvfi_omp(i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  ztfi(offset+i,l)=ztfi_omp(i,l)
+	enddo 
+      enddo
+	
+      do iq=1,nqtot
+        do l=1,llm
+          do i=1,klon
+            zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
+	  enddo
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zdufi(offset+i,l)=zdufi_omp(i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+	  zdvfi(offset+i,l)=zdvfi_omp(i,l)
+	enddo 
+      enddo
+	
+      do l=1,llm
+        do i=1,klon
+          zdtfi(offset+i,l)=zdtfi_omp(i,l)
+	enddo 
+      enddo
+	
+      do iq=1,nqtot
+        do l=1,llm
+          do i=1,klon
+	    zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
+	  enddo 
+        enddo
+      enddo
+      	
+      do i=1,klon
+	zdpsrf(offset+i)=zdpsrf_omp(i)
+      enddo 
+      
+
+      klon=klon_mpi
+500   CONTINUE
+c$OMP BARRIER
+
+c$OMP MASTER
+      call stop_timer(timer_physic)
+c$OMP END MASTER
+
+      IF (using_mpi) THEN
+            
+      if (MPI_rank>0) then
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
+       DO l=1,llm      
+        du_send(1:iim,l)=zdufi(1:iim,l)
+        dv_send(1:iim,l)=zdvfi(1:iim,l)
+       ENDDO
+c$OMP END DO NOWAIT       
+
+c$OMP BARRIER
+#ifdef CPP_MPI 
+c$OMP MASTER
+!$OMP CRITICAL (MPI)
+        call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
+     &                   COMM_LMDZ,Req(1),ierr)
+        call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
+     &                  COMM_LMDZ,Req(2),ierr)
+!$OMP END CRITICAL (MPI)
+c$OMP END MASTER
+#endif
+c$OMP BARRIER
+     
+      endif
+   
+      if (MPI_rank<MPI_Size-1) then
+c$OMP BARRIER
+#ifdef CPP_MPI 
+c$OMP MASTER      
+!$OMP CRITICAL (MPI)
+        call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
+     &                 COMM_LMDZ,Req(3),ierr)
+        call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
+     &                 COMM_LMDZ,Req(4),ierr)
+!$OMP END CRITICAL (MPI)
+c$OMP END MASTER
+#endif
+      endif
+
+c$OMP BARRIER
+
+
+#ifdef CPP_MPI 
+c$OMP MASTER    
+!$OMP CRITICAL (MPI)
+      if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
+        call MPI_WAITALL(4,Req(1),Status,ierr)
+      else if (MPI_rank>0) then
+        call MPI_WAITALL(2,Req(1),Status,ierr)
+      else if (MPI_rank <MPI_Size-1) then
+        call MPI_WAITALL(2,Req(3),Status,ierr)
+      endif
+!$OMP END CRITICAL (MPI)
+c$OMP END MASTER
+#endif
+
+c$OMP BARRIER     
+
+      ENDIF ! using_mpi
+      
+      
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+            
+        zdufi2(1:klon,l)=zdufi(1:klon,l)
+        zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l)
+            
+        zdvfi2(1:klon,l)=zdvfi(1:klon,l)
+        zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l) 
+  
+         pdhfi(:,jj_begin,l)=0
+         pdqfi(:,jj_begin,l,:)=0
+         pdufi(:,jj_begin,l)=0
+         pdvfi(:,jj_begin,l)=0
+         
+         if (.not. is_south_pole) then
+           pdhfi(:,jj_end,l)=0
+           pdqfi(:,jj_end,l,:)=0
+           pdufi(:,jj_end,l)=0
+           pdvfi(:,jj_end,l)=0
+         endif
+      
+       ENDDO 
+c$OMP END DO NOWAIT
+
+c$OMP MASTER
+       pdpsfi(:,jj_begin)=0    
+       if (.not. is_south_pole) then
+	 pdpsfi(:,jj_end)=0
+       endif
+c$OMP END MASTER
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+      CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
+c
+c   62. enthalpie potentielle
+c   ---------------------
+
+      kstart=1
+      kend=klon
+
+      if (is_north_pole) kstart=2
+      if (is_south_pole)  kend=klon-1
+      
+! ADAPTATION GCM POUR CP(T)
+      call t2tpot_p(klon,llm,ztfi,zteta,zpk)
+
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+!cdir NODEP
+        do ig0=kstart,kend
+          i=index_i(ig0)
+          j=index_j(ig0)
+!          pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
+          pdhfi(i,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
+!          if (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
+          if (i==1) then
+            pdhfi(iip1,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
+          endif
+         enddo          
+
+        if (is_north_pole) then
+            DO i=1,iip1
+!              pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+              pdhfi(i,1,l)    = (zteta(1,l) - pteta(i,1,l))/dtphys
+            enddo
+        endif
+        
+        if (is_south_pole) then
+            DO i=1,iip1
+!              pdhfi(i,jjp1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjp1,l)
+              pdhfi(i,jjp1,l) = (zteta(klon,l) - pteta(i,jjp1,l))/dtphys
+            ENDDO
+        endif
+      ENDDO
+c$OMP END DO NOWAIT
+      
+c   62. humidite specifique
+c   ---------------------
+! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
+!      DO iq=1,nqtot
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+!         DO l=1,llm
+!!!cdir NODEP 
+!           do ig0=kstart,kend
+!             i=index_i(ig0)
+!             j=index_j(ig0)
+!             pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq) 
+!             if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq) 
+!           enddo
+!           
+!           if (is_north_pole) then
+!             do i=1,iip1
+!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)             
+!             enddo
+!           endif
+!           
+!           if (is_south_pole) then
+!             do i=1,iip1
+!               pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq) 
+!             enddo
+!           endif
+!         ENDDO
+!c$OMP END DO NOWAIT
+!      ENDDO
+
+c   63. traceurs (tous en intensifs)
+c   ------------
+C     initialisation des tendances
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+        pdqfi(:,:,l,:)=0.
+      ENDDO
+c$OMP END DO NOWAIT	 
+
+C
+!cdir NODEP
+      DO iq=1,nqtot
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+         DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+!cdir NODEP           
+	     DO ig0=kstart,kend
+              i=index_i(ig0)
+              j=index_j(ig0)
+              pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
+              if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
+            ENDDO
+	    
+	    IF (is_north_pole) then
+	      DO i=1,iip1
+                pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+	      ENDDO
+	    ENDIF
+	    
+	    IF (is_south_pole) then
+	      DO i=1,iip1
+                pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
+	      ENDDO
+	    ENDIF
+	    
+         ENDDO
+c$OMP END DO NOWAIT	 
+      ENDDO
+      
+c   65. champ u:
+c   ------------
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+!cdir NODEP
+         do ig0=kstart,kend
+           i=index_i(ig0)
+           j=index_j(ig0)
+           
+           if (i/=iim) then
+             pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
+           endif
+           
+           if (i==1) then
+              pdufi(iim,j,l)=0.5*(  zdufi2(ig0,l)
+     $                            + zdufi2(ig0+iim-1,l))*cu(iim,j)
+             pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j)
+           endif
+         
+         enddo
+         
+         if (is_north_pole) then
+           DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+           ENDDO
+         endif
+         
+         if (is_south_pole) then
+           DO i=1,iip1
+            pdufi(i,jjp1,l) = 0.
+           ENDDO
+         endif
+         
+      ENDDO
+c$OMP END DO NOWAIT
+
+c   67. champ v:
+c   ------------
+
+      kstart=1
+      kend=klon
+
+      if (is_north_pole) kstart=2
+      if (is_south_pole)  kend=klon-1-iim
+      
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+      DO l=1,llm
+!CDIR ON_ADB(index_i)
+!CDIR ON_ADB(index_j) 
+!cdir NODEP
+        do ig0=kstart,kend
+           i=index_i(ig0)
+           j=index_j(ig0)
+           pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))*cv(i,j)
+           if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+
+     $	                                    zdvfi2(ig0+iim,l))
+     $				          *cv(i,j)
+        enddo
+         
+      ENDDO
+c$OMP END DO NOWAIT
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      if (is_north_pole) then
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+        DO l=1,llm
+
+          DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+       
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+          ENDDO
+
+          pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+
+        ENDDO
+c$OMP END DO NOWAIT
+
+      endif    
+      
+      if (is_south_pole) then
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
+         DO l=1,llm
+  
+           DO i=1,iim
+              pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i))
+     $        +zdvfi(klon,l)*SIN(rlonv(i))
+
+              pdvfi(i,jjm,l)=
+     $        0.5*(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))*cv(i,jjm)
+           ENDDO
+
+           pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+        ENDDO
+c$OMP END DO NOWAIT
+     
+      endif
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+ 
+      firstcal = .FALSE.
+
+#else
+      write(lunout,*)
+     & "calfis_p: for now can only work with parallel physics"
+      stop
+#endif
+! of #ifdef CPP_PHYS
+#endif
+! of #ifdef CPP_PARA
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,38 @@
+!
+! $Header$
+!
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi_p.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_dyn_fi_p.F	(revision 1403)
@@ -0,0 +1,44 @@
+!
+! $Id: gr_dyn_fi_p.F 1615 2012-02-10 15:42:26Z emillour $
+!
+      SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
+#ifdef CPP_PARA
+! Interface with parallel physics,
+      USE mod_interface_dyn_phys
+      USE dimphy
+      USE parallel_lmdz
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ig,l
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+c      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+c   traitement des point normaux
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO l=1,nfield    
+       DO ig=1,klon
+         i=index_i(ig)
+         j=index_j(ig)
+         pfi(ig,l)=pdyn(i,j,l)
+       ENDDO
+      ENDDO
+c$OMP END DO NOWAIT
+#endif
+! of #ifdef CPP_PARA
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
@@ -0,0 +1,40 @@
+!
+! $Header$
+!
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn_p.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn_p.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/gr_fi_dyn_p.F	(revision 1403)
@@ -0,0 +1,56 @@
+!
+! $Id: gr_fi_dyn_p.F 1615 2012-02-10 15:42:26Z emillour $
+!
+      SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
+#ifdef CPP_PARA
+! Interface with parallel physics,
+      USE mod_interface_dyn_phys
+      USE dimphy
+      USE parallel_lmdz
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      DO ifield=1,nfield
+
+        do ig=1,klon
+          i=index_i(ig)
+          j=index_j(ig)
+          pdyn(i,j,ifield)=pfi(ig,ifield)
+          if (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield)
+	enddo
+
+c   traitement des poles
+      if (pole_nord) then
+        do i=1,im
+	  pdyn(i,1,ifield)=pdyn(1,1,ifield)
+	enddo
+      endif
+       
+      if (pole_sud) then
+        do i=1,im
+	  pdyn(i,jm,ifield)=pdyn(1,jm,ifield)
+	enddo
+      endif
+      
+      ENDDO
+c$OMP END DO NOWAIT
+#endif
+! of #ifdef CPP_PARA
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,447 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_interface_dyn_phys.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_interface_dyn_phys.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_interface_dyn_phys.F90	(revision 1403)
@@ -0,0 +1,59 @@
+! 
+! $Id: mod_interface_dyn_phys.F90 1615 2012-02-10 15:42:26Z emillour $
+!
+MODULE mod_interface_dyn_phys
+  INTEGER,SAVE,dimension(:),allocatable :: index_i
+  INTEGER,SAVE,dimension(:),allocatable :: index_j
+  
+  
+#ifdef CPP_PHYS
+! Interface with parallel physics,
+CONTAINS
+  
+  SUBROUTINE Init_interface_dyn_phys
+    USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi, is_north_pole, is_south_pole, &
+                                      ii_begin, jj_begin, ii_end, jj_end
+    IMPLICIT NONE
+    include 'dimensions.h'    
+    
+    INTEGER :: i,j,k
+    
+    ALLOCATE(index_i(klon_mpi))
+    ALLOCATE(index_j(klon_mpi))
+    
+    k=1
+    IF (is_north_pole) THEN
+      index_i(k)=1
+      index_j(k)=1
+      k=2
+    ELSE
+      DO i=ii_begin,iim
+	index_i(k)=i
+	index_j(k)=jj_begin
+	k=k+1
+       ENDDO
+    ENDIF
+    
+    DO j=jj_begin+1,jj_end-1
+      DO i=1,iim
+	index_i(k)=i
+	index_j(k)=j
+	k=k+1
+      ENDDO
+    ENDDO
+    
+    IF (is_south_pole) THEN
+      index_i(k)=1
+      index_j(k)=jj_end
+    ELSE
+      DO i=1,ii_end
+	index_i(k)=i
+	index_j(k)=jj_end
+	k=k+1
+       ENDDO
+    ENDIF
+  
+  END SUBROUTINE Init_interface_dyn_phys 
+#endif
+! of #ifdef CPP_PHYS
+END MODULE mod_interface_dyn_phys
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phymars
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phymars	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phymars	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../../LMDZ.MARS/libf/dynlonlat_phylonlat/phymars
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phystd
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phystd	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phystd	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../../LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/ini_archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/ini_archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/ini_archive.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phytitan/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,195 @@
+
+! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
+
+
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
+  IMPLICIT NONE
+
+  ! =======================================================================
+  ! Initialisation of the physical constants and some positional and
+  ! geometrical arrays for the physics
+  ! =======================================================================
+
+  include "YOMCST.h"
+  include "iniprint.h"
+
+  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) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
+  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! 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 :: ibegin, iend, offset
+  INTEGER :: i,j
+  CHARACTER (LEN=20) :: modname = 'iniphysiq'
+  CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
+
+  IF (nlayer/=klev) THEN
+    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)
+  END IF
+
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
+
+  offset = klon_mpi_begin - 1
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+  ! Initialize some physical constants
+  call suphec
+
+!$OMP END PARALLEL
+
+  ! check that physical constants set in 'suphec' are coherent
+  ! with values set in the dynamics:
+  IF (rday/=punjours) THEN
+    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
+    WRITE (lunout, *) '  in the dynamics punjours=', punjours
+    WRITE (lunout, *) '   but in the physics RDAY=', rday
+    IF (abs(rday-punjours)>0.01*punjours) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'length of day discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+
+  IF (rg/=pg) THEN
+    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pg=', pg
+    WRITE (lunout, *) '  but in the physics RG=', rg
+    IF (abs(rg-pg)>0.01*pg) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'gravity discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (ra/=prad) THEN
+    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
+    WRITE (lunout, *) '   in the dynamics prad=', prad
+    WRITE (lunout, *) '  but in the physics RA=', ra
+    IF (abs(ra-prad)>0.01*prad) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'planet radius discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rd/=pr) THEN
+    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pr=', pr
+    WRITE (lunout, *) '  but in the physics RD=', rd
+    IF (abs(rd-pr)>0.01*pr) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'reduced gas constant discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rcpd/=pcpp) THEN
+    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
+    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
+    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'specific heat discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+
+END SUBROUTINE iniphysiq
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/newstart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/newstart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/newstart.F	(revision 1403)
@@ -0,0 +1,1138 @@
+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
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
+
+      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,razvitu,razvitv 
+      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--------------------------------------------------------------
+
+!!! ATTENTION TEMPORAIRE
+c     ps(:,:)=146700.
+
+      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, pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, pks, pk, pkf )
+         endif
+      
+c temperatures atmospheriques
+
+c ATTENTION: peut servir, mais bon...
+c     do l=1,lmold
+c      do j=1,jmold+1
+c       do i=1,imold+1
+c modif: profil uniforme
+c          told(i,j,l)=told(1,jmold/2,l)
+c mean T profile:
+c       told(i,j,l) = 142.1*exp(-((p3d(i,j,l)/100.+21.45)/40.11)**2.) 
+c    .              + 106.3*exp(-((p3d(i,j,l)/100.-3183.)/4737.)**2.)
+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,:,:)
+
+! RESETING U TO 0: may be done through run.def
+       razvitu = . FALSE .
+       CALL getin('razvitu',razvitu)
+       razvitv = . FALSE .
+       CALL getin('razvitv',razvitv)
+
+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)
+! Reseting u=0
+      if (razvitu) then
+           unat(:,:,:) = 0.
+      endif
+      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
+! Reseting v=0
+      if (razvitv) then
+           vnat(:,:,:) = 0.
+      endif
+      write (*,*) 'vnat ', vnat (1,2,1)    ! INFO
+      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.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/readstart.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phytitan/start2archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/start2archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/start2archive.F	(revision 1403)
@@ -0,0 +1,317 @@
+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,ini_cpdet
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
+
+      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 conf_gcm( 99, .TRUE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      call ini_cpdet
+
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+         if (disvert_type==1) then
+           CALL exner_hyb(  ip1jmp1, ps, p3d, pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, 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.COMMON/libf/dynlonlat_phylonlat/phytitan/startvar.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/startvar.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/startvar.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phytitan/write_archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/write_archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/write_archive.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phytitan/writerestart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/writerestart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phytitan/writerestart.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phyvenus/ini_archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/ini_archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/ini_archive.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phyvenus/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,195 @@
+
+! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
+
+
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
+  IMPLICIT NONE
+
+  ! =======================================================================
+  ! Initialisation of the physical constants and some positional and
+  ! geometrical arrays for the physics
+  ! =======================================================================
+
+  include "YOMCST.h"
+  include "iniprint.h"
+
+  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) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
+  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! 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 :: ibegin, iend, offset
+  INTEGER :: i,j
+  CHARACTER (LEN=20) :: modname = 'iniphysiq'
+  CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
+
+  IF (nlayer/=klev) THEN
+    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)
+  END IF
+
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
+
+  offset = klon_mpi_begin - 1
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+  ! Initialize some physical constants
+  call suphec
+
+!$OMP END PARALLEL
+
+  ! check that physical constants set in 'suphec' are coherent
+  ! with values set in the dynamics:
+  IF (rday/=punjours) THEN
+    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
+    WRITE (lunout, *) '  in the dynamics punjours=', punjours
+    WRITE (lunout, *) '   but in the physics RDAY=', rday
+    IF (abs(rday-punjours)>0.01*punjours) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'length of day discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+
+  IF (rg/=pg) THEN
+    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pg=', pg
+    WRITE (lunout, *) '  but in the physics RG=', rg
+    IF (abs(rg-pg)>0.01*pg) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'gravity discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (ra/=prad) THEN
+    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
+    WRITE (lunout, *) '   in the dynamics prad=', prad
+    WRITE (lunout, *) '  but in the physics RA=', ra
+    IF (abs(ra-prad)>0.01*prad) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'planet radius discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rd/=pr) THEN
+    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pr=', pr
+    WRITE (lunout, *) '  but in the physics RD=', rd
+    IF (abs(rd-pr)>0.01*pr) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'reduced gas constant discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rcpd/=pcpp) THEN
+    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
+    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
+    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'specific heat discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+
+END SUBROUTINE iniphysiq
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/newstart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/newstart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/newstart.F	(revision 1403)
@@ -0,0 +1,1176 @@
+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
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
+
+      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),fder(ngridmx)
+      real sollwdown(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),fderS(ip1jmp1)
+      real sollwdownS(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 :: fderold
+      real, dimension(:,:),   allocatable :: dlwold,sollwdownold
+      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,razvitu,razvitv 
+      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(fderold(imold+1,jmold+1))
+      allocate(sollwdownold(imold+1,jmold+1),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, "fder", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <fder> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,fderold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,fderold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <fder>"
+         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, "sollwdown", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <sollwdown> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,sollwdownold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,sollwdownold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <sollwdown>"
+         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)
+
+        print*,zmeaold(2,1:10)
+
+       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 (fderold,fderS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,fderS,fder)
+
+      call interp_horiz (dlwold,dlwS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,dlwS,dlw)
+
+      call interp_horiz (sollwdownold,sollwdownS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,sollwdownS,sollwdown)
+
+      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, pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, 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,:,:)
+
+! RESETING U TO 0: may be done through run.def
+       razvitu = . FALSE .
+       CALL getin('razvitu',razvitu)
+       razvitv = . FALSE .
+       CALL getin('razvitv',razvitv)
+
+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)
+! Reseting u=0
+      if (razvitu) then
+           unat(:,:,:) = 0.
+      endif
+      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
+! Reseting v=0
+      if (razvitv) then
+           vnat(:,:,:) = 0.
+      endif
+      write (*,*) 'vnat ', vnat (1,2,1)    ! INFO
+      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,fder,dlw,
+     .           sollwdown,radsol,
+     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .           t_fi)
+
+      print*,"restartphy OK"
+
+      end
Index: /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/readstart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/readstart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/readstart.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phyvenus/start2archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/start2archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/start2archive.F	(revision 1403)
@@ -0,0 +1,324 @@
+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,ini_cpdet
+      use exner_hyb_m, only: exner_hyb
+      use exner_milieu_m, only: exner_milieu
+
+      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),fder(ngridmx)
+      real sollwdown(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),fderS(ip1jmp1)
+      real dlwS(ip1jmp1),sollwdownS(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,
+     .       fder,dlw,sollwdown,radsol,
+     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .       tab_cntrl_fi)
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL conf_gcm( 99, .TRUE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      call ini_cpdet
+
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+         if (disvert_type==1) then
+           CALL exner_hyb(  ip1jmp1, ps, p3d, pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, 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,fder,fderS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,dlw,dlwS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sollwdown,sollwdownS)
+      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 déjà...'
+	 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,'fder','derive','?',2,fderS)
+      call write_archive(nid,'dlw','LW derive','?',2,dlwS)
+      call write_archive(nid,'sollwdown',
+     .             'LW dwn flux at surface','?',2,sollwdownS)
+      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.COMMON/libf/dynlonlat_phylonlat/phyvenus/startvar.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/startvar.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/startvar.F90	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phyvenus/write_archive.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/write_archive.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/write_archive.F	(revision 1403)
@@ -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.COMMON/libf/dynlonlat_phylonlat/phyvenus/writerestart.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/writerestart.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/dynlonlat_phylonlat/phyvenus/writerestart.F	(revision 1403)
@@ -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.COMMON/libf/misc/arth.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/arth.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/arth.F90	(revision 1403)
@@ -0,0 +1,82 @@
+MODULE arth_m
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8
+
+  INTERFACE arth
+     ! Returns an arithmetic progression, given a first term "first", an
+     ! increment and a number of terms "n".
+
+     MODULE PROCEDURE arth_r, arth_i
+     ! The difference between the procedures is the type of
+     ! arguments "first" and "increment" and of function result.
+  END INTERFACE
+
+  private arth_r, arth_i
+
+CONTAINS
+
+  pure FUNCTION arth_r(first,increment,n)
+
+    REAL, INTENT(IN) :: first,increment
+    INTEGER, INTENT(IN) :: n
+    REAL, DIMENSION(n) :: arth_r
+
+    ! Variables local to the procedure:
+
+    INTEGER :: k,k2
+    REAL :: temp
+
+    !---------------------------------------
+
+    if (n > 0) arth_r(1)=first
+    if (n <= NPAR_ARTH) then
+       do k=2,n
+          arth_r(k)=arth_r(k-1)+increment
+       end do
+    else
+       do k=2,NPAR2_ARTH
+          arth_r(k)=arth_r(k-1)+increment
+       end do
+       temp=increment*NPAR2_ARTH
+       k=NPAR2_ARTH
+       do
+          if (k >= n) exit
+          k2=k+k
+          arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k))
+          temp=temp+temp
+          k=k2
+       end do
+    end if
+  END FUNCTION arth_r
+
+  !*************************************
+
+  pure FUNCTION arth_i(first,increment,n)
+
+    INTEGER, INTENT(IN) :: first,increment,n
+    INTEGER, DIMENSION(n) :: arth_i
+    INTEGER :: k,k2,temp
+    if (n > 0) arth_i(1)=first
+    if (n <= NPAR_ARTH) then
+       do k=2,n
+          arth_i(k)=arth_i(k-1)+increment
+       end do
+    else
+       do k=2,NPAR2_ARTH
+          arth_i(k)=arth_i(k-1)+increment
+       end do
+       temp=increment*NPAR2_ARTH
+       k=NPAR2_ARTH
+       do
+          if (k >= n) exit
+          k2=k+k
+          arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
+          temp=temp+temp
+          k=k2
+       end do
+    end if
+  END FUNCTION arth_i
+
+END MODULE arth_m
Index: /trunk/LMDZ.COMMON/libf/misc/assert_eq_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/assert_eq_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/assert_eq_m.F90	(revision 1403)
@@ -0,0 +1,70 @@
+! $Id$
+MODULE assert_eq_m
+
+  implicit none
+
+  INTERFACE assert_eq
+     MODULE PROCEDURE assert_eq2,assert_eq3,assert_eq4,assert_eqn
+  END INTERFACE
+
+  private assert_eq2,assert_eq3,assert_eq4,assert_eqn
+
+CONTAINS
+
+  FUNCTION assert_eq2(n1,n2,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    INTEGER, INTENT(IN) :: n1,n2
+    INTEGER  assert_eq2
+    if (n1 == n2) then
+       assert_eq2=n1
+    else
+       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
+            string
+       print *, 'program terminated by assert_eq2'
+       stop 1
+    end if
+  END FUNCTION assert_eq2
+  !BL
+  FUNCTION assert_eq3(n1,n2,n3,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    INTEGER, INTENT(IN) :: n1,n2,n3
+    INTEGER  assert_eq3
+    if (n1 == n2 .and. n2 == n3) then
+       assert_eq3=n1
+    else
+       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
+            string
+       print *, 'program terminated by assert_eq3'
+       stop 1
+    end if
+  END FUNCTION assert_eq3
+  !BL
+  FUNCTION assert_eq4(n1,n2,n3,n4,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    INTEGER, INTENT(IN) :: n1,n2,n3,n4
+    INTEGER  assert_eq4
+    if (n1 == n2 .and. n2 == n3 .and. n3 == n4) then
+       assert_eq4=n1
+    else
+       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
+            string,n1,n2,n3,n4
+       print *, 'program terminated by assert_eq4'
+       stop 1
+    end if
+  END FUNCTION assert_eq4
+  !BL
+  FUNCTION assert_eqn(nn,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    INTEGER, DIMENSION(:), INTENT(IN) :: nn
+    INTEGER  assert_eqn
+    if (all(nn(2:) == nn(1))) then
+       assert_eqn=nn(1)
+    else
+       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
+            string
+       print *, 'program terminated by assert_eqn'
+       stop 1
+    end if
+  END FUNCTION assert_eqn
+
+END MODULE assert_eq_m
Index: /trunk/LMDZ.COMMON/libf/misc/assert_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/assert_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/assert_m.F90	(revision 1403)
@@ -0,0 +1,69 @@
+! $Id$
+MODULE assert_m
+
+  implicit none
+
+  INTERFACE assert
+     MODULE PROCEDURE assert1,assert2,assert3,assert4,assert_v
+  END INTERFACE
+
+  private assert1,assert2,assert3,assert4,assert_v
+
+CONTAINS
+
+  SUBROUTINE assert1(n1,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    LOGICAL, INTENT(IN) :: n1
+    if (.not. n1) then
+       write (*,*) 'nrerror: an assertion failed with this tag:', &
+            string
+       print *, 'program terminated by assert1'
+       stop 1
+    end if
+  END SUBROUTINE assert1
+  !BL
+  SUBROUTINE assert2(n1,n2,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    LOGICAL, INTENT(IN) :: n1,n2
+    if (.not. (n1 .and. n2)) then
+       write (*,*) 'nrerror: an assertion failed with this tag:', &
+            string
+       print *, 'program terminated by assert2'
+       stop 1
+    end if
+  END SUBROUTINE assert2
+  !BL
+  SUBROUTINE assert3(n1,n2,n3,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    LOGICAL, INTENT(IN) :: n1,n2,n3
+    if (.not. (n1 .and. n2 .and. n3)) then
+       write (*,*) 'nrerror: an assertion failed with this tag:', &
+            string
+       print *, 'program terminated by assert3'
+       stop 1
+    end if
+  END SUBROUTINE assert3
+  !BL
+  SUBROUTINE assert4(n1,n2,n3,n4,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    LOGICAL, INTENT(IN) :: n1,n2,n3,n4
+    if (.not. (n1 .and. n2 .and. n3 .and. n4)) then
+       write (*,*) 'nrerror: an assertion failed with this tag:', &
+            string
+       print *, 'program terminated by assert4'
+       stop 1
+    end if
+  END SUBROUTINE assert4
+  !BL
+  SUBROUTINE assert_v(n,string)
+    CHARACTER(LEN=*), INTENT(IN) :: string
+    LOGICAL, DIMENSION(:), INTENT(IN) :: n
+    if (.not. all(n)) then
+       write (*,*) 'nrerror: an assertion failed with this tag:', &
+            string
+       print *, 'program terminated by assert_v'
+       stop 1
+    end if
+  END SUBROUTINE assert_v
+
+END MODULE assert_m
Index: /trunk/LMDZ.COMMON/libf/misc/cbrt.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/cbrt.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/cbrt.F	(revision 1403)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/chfev.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/chfev.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/chfev.F	(revision 1403)
@@ -0,0 +1,155 @@
+*DECK CHFEV
+      SUBROUTINE CHFEV (X1, X2, F1, F2, D1, D2, NE, XE, FE, NEXT, IERR)
+C***BEGIN PROLOGUE  CHFEV
+C***PURPOSE  Evaluate a cubic polynomial given in Hermite form at an
+C            array of points.  While designed for use by PCHFE, it may
+C            be useful directly as an evaluator for a piecewise cubic
+C            Hermite function in applications, such as graphing, where
+C            the interval is known in advance.
+C***LIBRARY   SLATEC (PCHIP)
+C***CATEGORY  E3
+C***TYPE      SINGLE PRECISION (CHFEV-S, DCHFEV-D)
+C***KEYWORDS  CUBIC HERMITE EVALUATION, CUBIC POLYNOMIAL EVALUATION,
+C             PCHIP
+C***AUTHOR  Fritsch, F. N., (LLNL)
+C             Lawrence Livermore National Laboratory
+C             P.O. Box 808  (L-316)
+C             Livermore, CA  94550
+C             FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C          CHFEV:  Cubic Hermite Function EValuator
+C
+C     Evaluates the cubic polynomial determined by function values
+C     F1,F2 and derivatives D1,D2 on interval (X1,X2) at the points
+C     XE(J), J=1(1)NE.
+C
+C ----------------------------------------------------------------------
+C
+C  Calling sequence:
+C
+C        INTEGER  NE, NEXT(2), IERR
+C        REAL  X1, X2, F1, F2, D1, D2, XE(NE), FE(NE)
+C
+C        CALL  CHFEV (X1,X2, F1,F2, D1,D2, NE, XE, FE, NEXT, IERR)
+C
+C   Parameters:
+C
+C     X1,X2 -- (input) endpoints of interval of definition of cubic.
+C           (Error return if  X1.EQ.X2 .)
+C
+C     F1,F2 -- (input) values of function at X1 and X2, respectively.
+C
+C     D1,D2 -- (input) values of derivative at X1 and X2, respectively.
+C
+C     NE -- (input) number of evaluation points.  (Error return if
+C           NE.LT.1 .)
+C
+C     XE -- (input) real array of points at which the function is to be
+C           evaluated.  If any of the XE are outside the interval
+C           [X1,X2], a warning error is returned in NEXT.
+C
+C     FE -- (output) real array of values of the cubic function defined
+C           by  X1,X2, F1,F2, D1,D2  at the points  XE.
+C
+C     NEXT -- (output) integer array indicating number of extrapolation
+C           points:
+C            NEXT(1) = number of evaluation points to left of interval.
+C            NEXT(2) = number of evaluation points to right of interval.
+C
+C     IERR -- (output) error flag.
+C           Normal return:
+C              IERR = 0  (no errors).
+C           "Recoverable" errors:
+C              IERR = -1  if NE.LT.1 .
+C              IERR = -2  if X1.EQ.X2 .
+C                (The FE-array has not been changed in either case.)
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  XERMSG
+C***REVISION HISTORY  (YYMMDD)
+C   811019  DATE WRITTEN
+C   820803  Minor cosmetic changes for release 1.
+C   890411  Added SAVE statements (Vers. 3.2).
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890703  Corrected category record.  (WRB)
+C   890703  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
+C***END PROLOGUE  CHFEV
+C  Programming notes:
+C
+C     To produce a double precision version, simply:
+C        a. Change CHFEV to DCHFEV wherever it occurs,
+C        b. Change the real declaration to double precision, and
+C        c. Change the constant ZERO to double precision.
+C
+C  DECLARE ARGUMENTS.
+C
+      INTEGER  NE, NEXT(2), IERR
+      REAL  X1, X2, F1, F2, D1, D2, XE(*), FE(*)
+C
+C  DECLARE LOCAL VARIABLES.
+C
+      INTEGER  I
+      REAL  C2, C3, DEL1, DEL2, DELTA, H, X, XMI, XMA, ZERO
+      SAVE ZERO
+      DATA  ZERO /0./
+C
+C  VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT  CHFEV
+      IF (NE .LT. 1)  GO TO 5001
+      H = X2 - X1
+      IF (H .EQ. ZERO)  GO TO 5002
+C
+C  INITIALIZE.
+C
+      IERR = 0
+      NEXT(1) = 0
+      NEXT(2) = 0
+      XMI = MIN(ZERO, H)
+      XMA = MAX(ZERO, H)
+C
+C  COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
+C
+      DELTA = (F2 - F1)/H
+      DEL1 = (D1 - DELTA)/H
+      DEL2 = (D2 - DELTA)/H
+C                                           (DELTA IS NO LONGER NEEDED.)
+      C2 = -(DEL1+DEL1 + DEL2)
+      C3 = (DEL1 + DEL2)/H
+C                               (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
+C
+C  EVALUATION LOOP.
+C
+      DO 500  I = 1, NE
+         X = XE(I) - X1
+         FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
+C          COUNT EXTRAPOLATION POINTS.
+         IF ( X.LT.XMI )  NEXT(1) = NEXT(1) + 1
+         IF ( X.GT.XMA )  NEXT(2) = NEXT(2) + 1
+C        (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
+  500 CONTINUE
+C
+C  NORMAL RETURN.
+C
+      RETURN
+C
+C  ERROR RETURNS.
+C
+ 5001 CONTINUE
+C     NE.LT.1 RETURN.
+      IERR = -1
+      CALL XERMSG ('SLATEC', 'CHFEV',
+     +   'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+      RETURN
+C
+ 5002 CONTINUE
+C     X1.EQ.X2 RETURN.
+      IERR = -2
+      CALL XERMSG ('SLATEC', 'CHFEV', 'INTERVAL ENDPOINTS EQUAL', IERR,
+     +   1)
+      RETURN
+C------------- LAST LINE OF CHFEV FOLLOWS ------------------------------
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/cray.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/cray.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/cray.F	(revision 1403)
@@ -0,0 +1,42 @@
+!
+! $Header$
+!
+#ifdef CRAY
+      SUBROUTINE riencray
+      END
+#else
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
+
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+         ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
+#endif
Index: /trunk/LMDZ.COMMON/libf/misc/fdump.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/fdump.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/fdump.F	(revision 1403)
@@ -0,0 +1,31 @@
+*DECK FDUMP
+      SUBROUTINE FDUMP
+C***BEGIN PROLOGUE  FDUMP
+C***PURPOSE  Symbolic dump (should be locally written).
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3
+C***TYPE      ALL (FDUMP-A)
+C***KEYWORDS  ERROR, XERMSG
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C        ***Note*** Machine Dependent Routine
+C        FDUMP is intended to be replaced by a locally written
+C        version which produces a symbolic dump.  Failing this,
+C        it should be replaced by a version which prints the
+C        subprogram nesting list.  Note that this dump must be
+C        printed on each of up to five files, as indicated by the
+C        XGETUA routine.  See XSETUA and XGETUA for details.
+C
+C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C***END PROLOGUE  FDUMP
+C***FIRST EXECUTABLE STATEMENT  FDUMP
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/formcoord.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/formcoord.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/formcoord.F	(revision 1403)
@@ -0,0 +1,54 @@
+!
+! $Header$
+!
+      subroutine formcoord(unit,n,x,a,rev,text)
+      implicit none
+      integer n,unit,ndec
+      logical rev
+      real x(n),a
+      character*4 text
+
+      integer i,id,i1,i2,in
+      real dx,dxmin
+
+      if(rev) then
+         id=-1
+         i1=n
+         i2=n-1
+         in=1
+         write(unit,3000) text(1:1)
+      else
+         id=1
+         i1=1
+         i2=2
+         in=n
+      endif
+
+      if (n.lt.2) then
+         ndec=1
+         write(unit,1000) text,n,x(1)*a
+      else
+         dxmin=abs(x(2)-x(1))
+         do i=2,n-1
+            dx=abs(x(i+1)-x(i))
+            if (dx.lt.dxmin) dxmin=dx
+         enddo
+
+         ndec=-log10(dxmin)+2
+         if(mod(n,6).eq.1) then
+            write(unit,1000) text,n,x(i1)*a
+            write(unit,2000) (x(i)*a,i=i2,in,id)
+         else
+            write(unit,1000) text,n
+            write(unit,2000) (x(i)*a,i=i1,in,id)
+         endif
+      endif
+
+1000  format(a4,2x,i4,' LEVELS',43x,f12.2)
+2000  format(6f12.2)
+c1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
+c2000  format(6f12.<ndec>)
+3000  format('FORMAT ',a1,'REV')
+      return
+
+      end
Index: /trunk/LMDZ.COMMON/libf/misc/handle_err_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/handle_err_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/handle_err_m.F90	(revision 1403)
@@ -0,0 +1,46 @@
+! $Id$
+module handle_err_m
+
+  implicit none
+
+contains
+
+  subroutine handle_err(message, ncerr, ncid, varid)
+
+    use netcdf, only: nf90_strerror, nf90_noerr, nf90_close
+
+    character(len=*), intent(in):: message
+    ! (should include name of calling procedure)
+
+    integer, intent(in):: ncerr
+
+    integer, intent(in), optional :: ncid
+    ! (Provide this argument if you want "handle_err" to try to close
+    ! the file.)
+
+    integer, intent(in), optional :: varid
+
+    ! Variable local to the procedure:
+    integer ncerr_close
+
+    !-------------------
+
+    if (ncerr /= nf90_noerr) then
+       print *, message, ":"
+       if (present(varid)) print *, "varid = ", varid
+       print *, trim(nf90_strerror(ncerr))
+       if (present(ncid)) then
+          ! Try to close, to leave the file in a consistent state:
+          ncerr_close = nf90_close(ncid)
+          ! (do not call "nf95_close", we do not want to recurse)
+          if (ncerr_close /= nf90_noerr) then
+             print *, "nf90_close:"
+             print *, trim(nf90_strerror(ncerr_close))
+          end if
+       end if
+       call abort_gcm("NetCDF95 handle_err", "", 1)
+    end if
+
+  end subroutine handle_err
+
+end module handle_err_m
Index: /trunk/LMDZ.COMMON/libf/misc/i1mach.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/i1mach.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/i1mach.F	(revision 1403)
@@ -0,0 +1,128 @@
+*DECK I1MACH
+      INTEGER FUNCTION I1MACH (I)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  I1MACH
+C***PURPOSE  Return integer machine dependent constants.
+C***LIBRARY   SLATEC
+C***CATEGORY  R1
+C***TYPE      INTEGER (I1MACH-I)
+C***KEYWORDS  MACHINE CONSTANTS
+C***AUTHOR  Fox, P. A., (Bell Labs)
+C           Hall, A. D., (Bell Labs)
+C           Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C   I1MACH can be used to obtain machine-dependent parameters for the
+C   local machine environment.  It is a function subprogram with one
+C   (input) argument and can be referenced as follows:
+C
+C        K = I1MACH(I)
+C
+C   where I=1,...,16.  The (output) value of K above is determined by
+C   the (input) value of I.  The results for various values of I are
+C   discussed below.
+C
+C   I/O unit numbers:
+C     I1MACH( 1) = the standard input unit.
+C     I1MACH( 2) = the standard output unit.
+C     I1MACH( 3) = the standard punch unit.
+C     I1MACH( 4) = the standard error message unit.
+C
+C   Words:
+C     I1MACH( 5) = the number of bits per integer storage unit.
+C     I1MACH( 6) = the number of characters per integer storage unit.
+C
+C   Integers:
+C     assume integers are represented in the S-digit, base-A form
+C
+C                sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
+C
+C                where 0 .LE. X(I) .LT. A for I=0,...,S-1.
+C     I1MACH( 7) = A, the base.
+C     I1MACH( 8) = S, the number of base-A digits.
+C     I1MACH( 9) = A**S - 1, the largest magnitude.
+C
+C   Floating-Point Numbers:
+C     Assume floating-point numbers are represented in the T-digit,
+C     base-B form
+C                sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C                where 0 .LE. X(I) .LT. B for I=1,...,T,
+C                0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
+C     I1MACH(10) = B, the base.
+C
+C   Single-Precision:
+C     I1MACH(11) = T, the number of base-B digits.
+C     I1MACH(12) = EMIN, the smallest exponent E.
+C     I1MACH(13) = EMAX, the largest exponent E.
+C
+C   Double-Precision:
+C     I1MACH(14) = T, the number of base-B digits.
+C     I1MACH(15) = EMIN, the smallest exponent E.
+C     I1MACH(16) = EMAX, the largest exponent E.
+C
+C   To alter this function for a particular environment, the desired
+C   set of DATA statements should be activated by removing the C from
+C   column 1.  Also, the values of I1MACH(1) - I1MACH(4) should be
+C   checked for consistency with the local operating system.
+C
+C***REFERENCES  P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C                 a portable library, ACM Transactions on Mathematical
+C                 Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   750101  DATE WRITTEN
+C   891012  Added VAX G-floating constants.  (WRB)
+C   891012  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900618  Added DEC RISC constants.  (WRB)
+C   900723  Added IBM RS 6000 constants.  (WRB)
+C   901009  Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16.
+C           (RWC)
+C   910710  Added HP 730 constants.  (SMR)
+C   911114  Added Convex IEEE constants.  (WRB)
+C   920121  Added SUN -r8 compiler option constants.  (WRB)
+C   920229  Added Touchstone Delta i860 constants.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C   920625  Added Convex -p8 and -pd8 compiler option constants.
+C           (BKS, WRB)
+C   930201  Added DEC Alpha and SGI constants.  (RWC and WRB)
+C   930618  Corrected I1MACH(5) for Convex -p8 and -pd8 compiler
+C           options.  (DWL, RWC and WRB).
+C   100623  Use Fortran 95 intrinsic functions (Lionel GUEZ)
+C***END PROLOGUE  I1MACH
+C
+      INTEGER IMACH(16),OUTPUT
+      SAVE IMACH
+      EQUIVALENCE (IMACH(4),OUTPUT)
+      INTEGER I
+C***FIRST EXECUTABLE STATEMENT  I1MACH
+      IMACH( 1) =         5
+      IMACH( 2) =         6
+      IMACH( 3) =         6
+      IMACH( 4) =         6
+      IMACH( 5) =        bit_size(0)
+      IMACH( 6) =         IMACH( 5) / 8
+      IMACH( 7) =         radix(0)
+      IMACH( 8) =        digits(0)
+      IMACH( 9) =     huge(0)
+      IMACH(10) =         radix(0.)
+      IMACH(11) =        digits(0.)
+      IMACH(12) =      minexponent(0.)
+      IMACH(13) =       maxexponent(0.)
+      IMACH(14) =        digits(0d0)
+      IMACH(15) =      minexponent(0d0)
+      IMACH(16) =       maxexponent(0d0)
+      IF (I .LT. 1  .OR.  I .GT. 16) GO TO 10
+C
+      I1MACH = IMACH(I)
+      RETURN
+C
+   10 CONTINUE
+      WRITE (UNIT = OUTPUT, FMT = 9000)
+ 9000 FORMAT ('1ERROR    1 IN I1MACH - I OUT OF BOUNDS')
+C
+C     CALL FDUMP
+C
+      STOP
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/interpolation.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/interpolation.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/interpolation.F90	(revision 1403)
@@ -0,0 +1,138 @@
+! $Id$
+module interpolation
+
+  ! From Press et al., 1996, version 2.10a
+  ! B3 Interpolation and Extrapolation
+
+  IMPLICIT NONE 
+
+contains
+
+  pure FUNCTION locate(xx,x)
+
+    REAL, DIMENSION(:), INTENT(IN) :: xx
+    REAL, INTENT(IN) :: x
+    INTEGER  locate
+
+    ! Given an array xx(1:N), and given a value x, returns a value j,
+    ! between 0 and N, such that x is between xx(j) and xx(j + 1). xx
+    ! must be monotonic, either increasing or decreasing. j = 0 or j =
+    ! N is returned to indicate that x is out of range. This
+    ! procedure should not be called with a zero-sized array argument.
+    ! See notes.
+
+    INTEGER  n,jl,jm,ju
+    LOGICAL  ascnd
+
+    !----------------------------
+
+    n=size(xx)
+    ascnd = (xx(n) >= xx(1))
+    ! (True if ascending order of table, false otherwise.)
+    ! Initialize lower and upper limits:
+    jl=0
+    ju=n+1
+    do while (ju-jl > 1)
+       jm=(ju+jl)/2 ! Compute a midpoint,
+       if (ascnd .eqv. (x >= xx(jm))) then
+          jl=jm ! and replace either the lower limit
+       else
+          ju=jm ! or the upper limit, as appropriate.
+       end if
+    end do
+    ! {ju == jl + 1}
+
+    ! {(ascnd .and. xx(jl) <= x < xx(jl+1)) 
+    !  .neqv. 
+    !  (.not. ascnd .and. xx(jl+1) <= x < xx(jl))}
+
+    ! Then set the output, being careful with the endpoints:
+    if (x == xx(1)) then
+       locate=1
+    else if (x == xx(n)) then
+       locate=n-1
+    else
+       locate=jl
+    end if
+
+  END FUNCTION locate
+
+  !***************************
+
+  pure SUBROUTINE hunt(xx,x,jlo)
+
+    ! Given an array xx(1:N ), and given a value x, returns a value
+    ! jlo such that x is between xx(jlo) and xx(jlo+1). xx must be
+    ! monotonic, either increasing or decreasing. jlo = 0 or jlo = N is
+    ! returned to indicate that x is out of range. jlo on input is taken as
+    ! the initial guess for jlo on output.
+    ! Modified so that it uses the information "jlo = 0" on input.
+
+    INTEGER, INTENT(INOUT) :: jlo
+    REAL, INTENT(IN) :: x
+    REAL, DIMENSION(:), INTENT(IN) :: xx
+    INTEGER  n,inc,jhi,jm
+    LOGICAL  ascnd, hunt_up
+
+    !-----------------------------------------------------
+
+    n=size(xx)
+    ascnd = (xx(n) >= xx(1))
+    ! (True if ascending order of table, false otherwise.)
+    if (jlo < 0 .or. jlo > n) then
+       ! Input guess not useful. Go immediately to bisection.
+       jlo=0
+       jhi=n+1
+    else
+       inc=1 ! Set the hunting increment.
+       if (jlo == 0) then
+          hunt_up = .true.
+       else
+          hunt_up = x >= xx(jlo) .eqv. ascnd
+       end if
+       if (hunt_up) then ! Hunt up:
+          do
+             jhi=jlo+inc
+             if (jhi > n) then ! Done hunting, since off end of table.
+                jhi=n+1
+                exit
+             else
+                if (x < xx(jhi) .eqv. ascnd) exit
+                jlo=jhi ! Not done hunting,
+                inc=inc+inc ! so double the increment
+             end if
+          end do ! and try again.
+       else ! Hunt down:
+          jhi=jlo
+          do
+             jlo=jhi-inc
+             if (jlo < 1) then ! Done hunting, since off end of table.
+                jlo=0
+                exit
+             else
+                if (x >= xx(jlo) .eqv. ascnd) exit
+                jhi=jlo ! Not done hunting,
+                inc=inc+inc ! so double the increment
+             end if
+          end do ! and try again.
+       end if
+    end if ! Done hunting, value bracketed.
+
+    do ! Hunt is done, so begin the final bisection phase:
+       if (jhi-jlo <= 1) then
+          if (x == xx(n)) jlo=n-1
+          if (x == xx(1)) jlo=1
+          exit
+       else
+          jm=(jhi+jlo)/2
+          if (x >= xx(jm) .eqv. ascnd) then
+             jlo=jm
+          else
+             jhi=jm
+          end if
+       end if
+    end do
+
+  END SUBROUTINE hunt
+
+end module interpolation
Index: /trunk/LMDZ.COMMON/libf/misc/ioipsl_errioipsl.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
@@ -0,0 +1,219 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE ioipsl_errioipsl
Index: /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom.F90	(revision 1403)
@@ -0,0 +1,1980 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the run.def file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the run.def file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from run.def
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = 'run.def'
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file='run.def.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of run.def and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE ioipsl_getincom
Index: /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom_p.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom_p.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ioipsl_getincom_p.F90	(revision 1403)
@@ -0,0 +1,170 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom_p
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_getincom ! to use  'getin'
+USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
+use mod_phys_lmdz_para, only : bcast
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin_p
+!-
+INTERFACE getin_p
+
+  MODULE PROCEDURE getinrs_p, getinr1d_p, getinr2d_p, &
+ &                 getinis_p, getini1d_p, getini2d_p, &
+ &                 getincs_p, 		              &
+ &                 getinls_p, getinl1d_p, getinl2d_p
+END INTERFACE
+!-
+CONTAINS
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition des getin -> bcast      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaines de caracteres -- !!
+  
+  SUBROUTINE getincs_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut    
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getincs_p
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE getinis_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut    
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinis_p
+
+  SUBROUTINE getini1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getini1d_p
+
+  SUBROUTINE getini2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getini2d_p
+
+!! -- Les flottants -- !!
+  
+  SUBROUTINE getinrs_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinrs_p
+
+  SUBROUTINE getinr1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinr1d_p
+
+  SUBROUTINE getinr2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinr2d_p
+
+!! -- Les Booleens -- !!
+  
+  SUBROUTINE getinls_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinls_p
+
+  SUBROUTINE getinl1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinl1d_p
+
+  SUBROUTINE getinl2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinl2d_p
+!-
+!-----------------------------
+!-----------------------------
+!-----------------------------
+
+END MODULE ioipsl_getincom_p
Index: /trunk/LMDZ.COMMON/libf/misc/ioipsl_stringop.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ioipsl_stringop.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ioipsl_stringop.F90	(revision 1403)
@@ -0,0 +1,243 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE ioipsl_stringop
Index: /trunk/LMDZ.COMMON/libf/misc/ismax.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ismax.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ismax.F	(revision 1403)
@@ -0,0 +1,24 @@
+!
+! $Header$
+!
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+       ix=ix+incx
+       if(sx(ix).gt.sxmax) then
+         sxmax=sx(ix)
+         ismax=i+1
+       endif
+10    continue
+c
+      return
+      end
+
Index: /trunk/LMDZ.COMMON/libf/misc/ismin.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/ismin.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/ismin.F	(revision 1403)
@@ -0,0 +1,24 @@
+!
+! $Header$
+!
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+         ix=ix+incx
+         if(sx(ix).lt.sxmin) then
+             sxmin=sx(ix)
+             ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
+C
Index: /trunk/LMDZ.COMMON/libf/misc/j4save.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/j4save.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/j4save.F	(revision 1403)
@@ -0,0 +1,67 @@
+*DECK J4SAVE
+      FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  J4SAVE
+C***SUBSIDIARY
+C***PURPOSE  Save or recall global variables needed by error
+C            handling routines.
+C***LIBRARY   SLATEC (XERROR)
+C***TYPE      INTEGER (J4SAVE-I)
+C***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        J4SAVE saves and recalls several global variables needed
+C        by the library error handling routines.
+C
+C     Description of Parameters
+C      --Input--
+C        IWHICH - Index of item desired.
+C                = 1 Refers to current error number.
+C                = 2 Refers to current error control flag.
+C                = 3 Refers to current unit number to which error
+C                    messages are to be sent.  (0 means use standard.)
+C                = 4 Refers to the maximum number of times any
+C                     message is to be printed (as set by XERMAX).
+C                = 5 Refers to the total number of units to which
+C                     each error message is to be written.
+C                = 6 Refers to the 2nd unit for error messages
+C                = 7 Refers to the 3rd unit for error messages
+C                = 8 Refers to the 4th unit for error messages
+C                = 9 Refers to the 5th unit for error messages
+C        IVALUE - The value to be set for the IWHICH-th parameter,
+C                 if ISET is .TRUE. .
+C        ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
+C                 given the value, IVALUE.  If ISET=.FALSE., the
+C                 IWHICH-th parameter will be unchanged, and IVALUE
+C                 is a dummy parameter.
+C      --Output--
+C        The (old) value of the IWHICH-th parameter will be returned
+C        in the function value, J4SAVE.
+C
+C***SEE ALSO  XERMSG
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900205  Minor modifications to prologue.  (WRB)
+C   900402  Added TYPE section.  (WRB)
+C   910411  Added KEYWORDS section.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  J4SAVE
+      LOGICAL ISET
+      INTEGER IPARAM(9)
+      SAVE IPARAM
+      DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
+      DATA IPARAM(5)/1/
+      DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
+      INTEGER J4SAVE,IWHICH,IVALUE
+C***FIRST EXECUTABLE STATEMENT  J4SAVE
+      J4SAVE = IPARAM(IWHICH)
+      IF (ISET) IPARAM(IWHICH) = IVALUE
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/misc_mod.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/misc_mod.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/misc_mod.F90	(revision 1403)
@@ -0,0 +1,6 @@
+module misc_mod
+  integer,save :: itaumax
+  logical,save :: adjust
+  integer,save :: ItCount
+  logical,save :: debug
+end module misc_mod 
Index: /trunk/LMDZ.COMMON/libf/misc/netcdf95.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/netcdf95.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/netcdf95.F90	(revision 1403)
@@ -0,0 +1,17 @@
+! $Id$
+module netcdf95
+
+  ! Author: Lionel GUEZ
+  ! See:
+  ! http://www.lmd.jussieu.fr/~lglmd/NetCDF95
+
+  use nf95_def_var_m
+  use nf95_put_var_m
+  use nf95_get_var_m
+  use nf95_gw_var_m
+  use nf95_put_att_m
+  use nf95_get_att_m
+  use simple
+  use handle_err_m
+
+end module netcdf95
Index: /trunk/LMDZ.COMMON/libf/misc/new_unit_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/new_unit_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/new_unit_m.F90	(revision 1403)
@@ -0,0 +1,25 @@
+module new_unit_m
+
+  implicit none
+
+contains
+
+  subroutine new_unit(unit)
+
+    integer, intent(out):: unit
+
+    ! Variables local to the procedure:
+    logical opened, exist
+
+    !------------------------------------------------------
+
+    unit = 0
+    do
+       inquire(unit=unit, opened=opened, exist=exist)
+       if (exist .and. .not. opened) exit
+       unit = unit + 1
+    end do
+
+  end subroutine new_unit
+
+end module new_unit_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_def_var_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_def_var_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_def_var_m.F90	(revision 1403)
@@ -0,0 +1,102 @@
+! $Id$
+module nf95_def_var_m
+
+  ! The generic procedure name "nf90_def_var" applies to
+  ! "nf90_def_var_Scalar" but we cannot apply the generic procedure name
+  ! "nf95_def_var" to "nf95_def_var_scalar" because of the additional
+  ! optional argument.
+  ! "nf95_def_var_scalar" cannot be distinguished from "nf95_def_var_oneDim".
+
+  implicit none
+
+  interface nf95_def_var
+    module procedure nf95_def_var_oneDim, nf95_def_var_ManyDims
+  end interface
+
+  private
+  public nf95_def_var, nf95_def_var_scalar
+
+contains
+
+  subroutine nf95_def_var_scalar(ncid, name, xtype, varid, ncerr)
+
+    use netcdf, only: nf90_def_var
+    use handle_err_m, only: handle_err
+
+    integer,               intent( in) :: ncid
+    character (len = *),   intent( in) :: name
+    integer,               intent( in) :: xtype
+    integer,               intent(out) :: varid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_def_var(ncid, name, xtype, varid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_def_var_scalar " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_def_var_scalar
+
+  !***********************
+
+  subroutine nf95_def_var_oneDim(ncid, name, xtype, dimids, varid, ncerr)
+
+    use netcdf, only: nf90_def_var
+    use handle_err_m, only: handle_err
+
+    integer,               intent( in) :: ncid
+    character (len = *),   intent( in) :: name
+    integer,               intent( in) :: xtype
+    integer,               intent( in) :: dimids
+    integer,               intent(out) :: varid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_def_var(ncid, name, xtype, dimids, varid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_def_var_oneDim " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_def_var_oneDim
+
+  !***********************
+
+  subroutine nf95_def_var_ManyDims(ncid, name, xtype, dimids, varid, ncerr)
+
+    use netcdf, only: nf90_def_var
+    use handle_err_m, only: handle_err
+
+    integer,               intent( in) :: ncid
+    character (len = *),   intent( in) :: name
+    integer,               intent( in) :: xtype
+    integer, dimension(:), intent( in) :: dimids
+    integer,               intent(out) :: varid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_def_var(ncid, name, xtype, dimids, varid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_def_var_ManyDims " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_def_var_ManyDims
+
+end module nf95_def_var_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_get_att_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_get_att_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_get_att_m.F90	(revision 1403)
@@ -0,0 +1,105 @@
+! $Id$
+module nf95_get_att_m
+
+  use handle_err_m, only: handle_err
+  use netcdf, only: nf90_get_att, nf90_noerr
+  use simple, only: nf95_inquire_attribute
+
+  implicit none
+
+  interface nf95_get_att
+     module procedure nf95_get_att_text, nf95_get_att_one_FourByteInt
+
+     ! The difference between the specific procedures is the type of
+     ! argument "values".
+  end interface
+
+  private
+  public nf95_get_att
+
+contains
+
+  subroutine nf95_get_att_text(ncid, varid, name, values, ncerr)
+
+    integer,                          intent( in) :: ncid, varid
+    character(len = *),               intent( in) :: name
+    character(len = *),               intent(out) :: values
+    integer, intent(out), optional:: ncerr
+
+    ! Variables local to the procedure:
+    integer ncerr_not_opt
+    integer att_len
+
+    !-------------------
+
+    ! Check that the length of "values" is large enough:
+    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
+         ncerr=ncerr_not_opt)
+    if (ncerr_not_opt == nf90_noerr) then
+       if (len(values) < att_len) then
+          print *, "nf95_get_att_text"
+          print *, "varid = ", varid
+          print *, "attribute name: ", name
+          print *, 'length of "values" is not large enough'
+          print *, "len(values) = ", len(values)
+          print *, "number of characters in attribute: ", att_len
+          stop 1
+       end if
+    end if
+
+    values = "" ! useless in NetCDF version 3.6.2 or better
+    ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_att_text " // trim(name), ncerr_not_opt, &
+            ncid, varid)
+    end if
+
+    if (att_len >= 1 .and. ncerr_not_opt == nf90_noerr) then
+       ! Remove null terminator, if any:
+       if (iachar(values(att_len:att_len)) == 0) values(att_len:att_len) = " "
+    end if
+
+  end subroutine nf95_get_att_text
+
+  !***********************
+
+  subroutine nf95_get_att_one_FourByteInt(ncid, varid, name, values, ncerr)
+
+    integer,                                    intent( in) :: ncid, varid
+    character(len = *),                         intent( in) :: name
+    integer ,               intent(out) :: values
+    integer, intent(out), optional:: ncerr
+
+    ! Variables local to the procedure:
+    integer ncerr_not_opt
+    integer att_len
+
+    !-------------------
+
+    ! Check that the attribute contains a single value:
+    call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
+         ncerr=ncerr_not_opt)
+    if (ncerr_not_opt == nf90_noerr) then
+       if (att_len /= 1) then
+          print *, "nf95_get_att_one_FourByteInt"
+          print *, "varid = ", varid
+          print *, "attribute name: ", name
+          print *, 'the attribute does not contain a single value'
+          print *, "number of values in attribute: ", att_len
+          stop 1
+       end if
+    end if
+
+    ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_att_one_FourByteInt " // trim(name), &
+            ncerr_not_opt, ncid, varid)
+    end if
+
+  end subroutine nf95_get_att_one_FourByteInt
+
+end module nf95_get_att_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_get_var_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_get_var_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_get_var_m.F90	(revision 1403)
@@ -0,0 +1,391 @@
+module nf95_get_var_m
+
+  use netcdf, only: nf90_get_var
+  use handle_err_m, only: handle_err
+
+  implicit none
+
+  interface nf95_get_var
+     module procedure nf95_get_var_FourByteReal, nf95_get_var_FourByteInt, &
+          nf95_get_var_1D_FourByteReal, nf95_get_var_1D_FourByteInt, &
+          nf95_get_var_2D_FourByteReal, &
+          nf95_get_var_3D_FourByteInt, &
+          nf95_get_var_3D_FourByteReal, &
+          nf95_get_var_4D_FourByteReal, &
+          nf95_get_var_5D_FourByteReal
+  end interface
+
+  private
+  public nf95_get_var
+
+contains
+
+  subroutine nf95_get_var_FourByteReal(ncid, varid, values, start, ncerr)
+
+    integer, intent(in) :: ncid, varid
+    real, intent(out) :: values
+    integer, dimension(:), optional, intent(in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_FourByteInt(ncid, varid, values, start, ncerr)
+
+    integer, intent(in) :: ncid, varid
+    integer, intent(out) :: values
+    integer, dimension(:), optional, intent(in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_FourByteInt
+
+  !***********************
+
+  subroutine nf95_get_var_1D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer,                         intent(in) :: ncid, varid
+    real, intent(out) :: values(:)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_1D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_1D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_1D_FourByteInt(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer,                         intent(in) :: ncid, varid
+    integer, intent(out) :: values(:)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_1D_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_1D_FourByteInt
+
+  !***********************
+
+  subroutine nf95_get_var_1D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: eightByteReal
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal),     intent(out) :: values(:)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_1D_eightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_1D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_2D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer,                         intent(in) :: ncid, varid
+    real , intent(out) :: values(:, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_2D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_2D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_2D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: EightByteReal
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal), intent(out) :: values(:, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_2D_EightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_2D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_3D_FourByteInt(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer, intent(in):: ncid, varid
+    integer, intent(out):: values(:, :, :)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_3D_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_3D_FourByteInt
+
+  !***********************
+
+  subroutine nf95_get_var_3D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer,                         intent(in) :: ncid, varid
+    real , intent(out) :: values(:, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_3D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_3D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_3D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: eightByteReal
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal),     intent(out) :: values(:, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_3D_eightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_3D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_4D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer,                         intent(in) :: ncid, varid
+    real , intent(out) :: values(:, :, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_4D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_4D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_4D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: EightByteReal
+
+    integer, intent(in):: ncid, varid
+    real(kind = EightByteReal), intent(out):: values(:, :, :, :)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_4D_EightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_4D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_5D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    integer, intent(in):: ncid, varid
+    real, intent(out):: values(:, :, :, :, :)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_5D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_5D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_get_var_5D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: EightByteReal
+
+    integer, intent(in):: ncid, varid
+    real(kind = EightByteReal), intent(out):: values(:, :, :, :, :)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_get_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_get_var_5D_EightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_get_var_5D_EightByteReal
+
+end module nf95_get_var_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_gw_var_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_gw_var_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_gw_var_m.F90	(revision 1403)
@@ -0,0 +1,336 @@
+! $Id$
+module nf95_gw_var_m
+
+  use nf95_get_var_m, only: NF95_GET_VAR
+  use simple, only: nf95_inquire_variable, nf95_inquire_dimension
+
+  implicit none
+
+  interface nf95_gw_var
+     ! "nf95_gw_var" stands for "NetCDF 1995 get whole variable".
+     ! These procedures read a whole NetCDF variable (coordinate or
+     ! primary) into an array.
+     ! The difference between the procedures is the rank and type of
+     ! argument "values".
+     ! The procedures do not check the type of the NetCDF variable.
+
+     ! Not including double precision procedures in the generic
+     ! interface because we use a compilation option that changes default
+     ! real precision.
+     module procedure nf95_gw_var_real_1d, nf95_gw_var_real_2d, &
+          nf95_gw_var_real_3d, nf95_gw_var_real_4d, nf95_gw_var_real_5d, &
+          nf95_gw_var_int_1d, nf95_gw_var_int_3d
+  end interface
+
+  private
+  public nf95_gw_var
+
+contains
+
+  subroutine nf95_gw_var_real_1d(ncid, varid, values)
+
+    ! Real type, the array has rank 1.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    real, pointer:: values(:)
+
+    ! Variables local to the procedure:
+    integer nclen
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 1) then
+       print *, "nf95_gw_var_real_1d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
+       stop 1
+    end if
+
+    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
+    deallocate(dimids) ! pointer
+
+    allocate(values(nclen))
+    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_real_1d
+
+  !************************************
+
+  subroutine nf95_gw_var_real_2d(ncid, varid, values)
+
+    ! Real type, the array has rank 2.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    real, pointer:: values(:, :)
+
+    ! Variables local to the procedure:
+    integer nclen1, nclen2
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 2) then
+       print *, "nf95_gw_var_real_2d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 2"
+       stop 1
+    end if
+
+    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
+    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
+    deallocate(dimids) ! pointer
+
+    allocate(values(nclen1, nclen2))
+    if (nclen1 /= 0 .and. nclen2 /= 0) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_real_2d
+
+  !************************************
+
+  subroutine nf95_gw_var_real_3d(ncid, varid, values)
+
+    ! Real type, the array has rank 3.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    real, pointer:: values(:, :, :)
+
+    ! Variables local to the procedure:
+    integer nclen1, nclen2, nclen3
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 3) then
+       print *, "nf95_gw_var_real_3d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
+       stop 1
+    end if
+
+    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
+    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
+    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
+    deallocate(dimids) ! pointer
+
+    allocate(values(nclen1, nclen2, nclen3))
+    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_real_3d
+
+  !************************************
+
+  subroutine nf95_gw_var_real_4d(ncid, varid, values)
+
+    ! Real type, the array has rank 4.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    real, pointer:: values(:, :, :, :)
+
+    ! Variables local to the procedure:
+    integer len_dim(4), i
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 4) then
+       print *, "nf95_gw_var_real_4d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 4"
+       stop 1
+    end if
+
+    do i = 1, 4
+       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
+    end do
+    deallocate(dimids) ! pointer
+
+    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4)))
+    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_real_4d
+
+  !************************************
+
+  subroutine nf95_gw_var_real_5d(ncid, varid, values)
+
+    ! Real type, the array has rank 5.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    real, pointer:: values(:, :, :, :, :)
+
+    ! Variables local to the procedure:
+    integer len_dim(5), i
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 5) then
+       print *, "nf95_gw_var_real_5d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 5"
+       stop 1
+    end if
+
+    do i = 1, 5
+       call nf95_inquire_dimension(ncid, dimids(i), nclen=len_dim(i))
+    end do
+    deallocate(dimids) ! pointer
+
+    allocate(values(len_dim(1), len_dim(2), len_dim(3), len_dim(4), len_dim(5)))
+    if (all(len_dim /= 0)) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_real_5d
+
+  !************************************
+
+!!$  subroutine nf95_gw_var_dble_1d(ncid, varid, values)
+!!$
+!!$    ! Double precision, the array has rank 1.
+!!$
+!!$    integer, intent(in):: ncid
+!!$    integer, intent(in):: varid
+!!$    double precision, pointer:: values(:)
+!!$
+!!$    ! Variables local to the procedure:
+!!$    integer nclen
+!!$    integer, pointer:: dimids(:)
+!!$
+!!$    !---------------------
+!!$
+!!$    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+!!$
+!!$    if (size(dimids) /= 1) then
+!!$       print *, "nf95_gw_var_dble_1d:"
+!!$       print *, "varid = ", varid
+!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
+!!$        stop 1
+!!$    end if
+!!$
+!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
+!!$    deallocate(dimids) ! pointer
+!!$
+!!$    allocate(values(nclen))
+!!$    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
+!!$
+!!$  end subroutine nf95_gw_var_dble_1d
+!!$
+!!$  !************************************
+!!$
+!!$  subroutine nf95_gw_var_dble_3d(ncid, varid, values)
+!!$
+!!$    ! Double precision, the array has rank 3.
+!!$
+!!$    integer, intent(in):: ncid
+!!$    integer, intent(in):: varid
+!!$    double precision, pointer:: values(:, :, :)
+!!$
+!!$    ! Variables local to the procedure:
+!!$    integer nclen1, nclen2, nclen3
+!!$    integer, pointer:: dimids(:)
+!!$
+!!$    !---------------------
+!!$
+!!$    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+!!$
+!!$    if (size(dimids) /= 3) then
+!!$       print *, "nf95_gw_var_dble_3d:"
+!!$       print *, "varid = ", varid
+!!$       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
+!!$       stop 1
+!!$    end if
+!!$
+!!$    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
+!!$    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
+!!$    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
+!!$    deallocate(dimids) ! pointer
+!!$
+!!$    allocate(values(nclen1, nclen2, nclen3))
+!!$    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
+!!$
+!!$  end subroutine nf95_gw_var_dble_3d
+!!$
+  !************************************
+
+  subroutine nf95_gw_var_int_1d(ncid, varid, values)
+
+    ! Integer type, the array has rank 1.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    integer, pointer:: values(:)
+
+    ! Variables local to the procedure:
+    integer nclen
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 1) then
+       print *, "nf95_gw_var_int_1d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 1"
+       stop 1
+    end if
+
+    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen)
+    deallocate(dimids) ! pointer
+
+    allocate(values(nclen))
+    if (nclen /= 0) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_int_1d
+
+  !************************************
+
+  subroutine nf95_gw_var_int_3d(ncid, varid, values)
+
+    ! Integer type, the array has rank 3.
+
+    integer, intent(in):: ncid
+    integer, intent(in):: varid
+    integer, pointer:: values(:, :, :)
+
+    ! Variables local to the procedure:
+    integer nclen1, nclen2, nclen3
+    integer, pointer:: dimids(:)
+
+    !---------------------
+
+    call nf95_inquire_variable(ncid, varid, dimids=dimids)
+
+    if (size(dimids) /= 3) then
+       print *, "nf95_gw_var_int_3d:"
+       print *, "varid = ", varid
+       print *, "rank of NetCDF variable is ", size(dimids), ", not 3"
+       stop 1
+    end if
+
+    call nf95_inquire_dimension(ncid, dimids(1), nclen=nclen1)
+    call nf95_inquire_dimension(ncid, dimids(2), nclen=nclen2)
+    call nf95_inquire_dimension(ncid, dimids(3), nclen=nclen3)
+    deallocate(dimids) ! pointer
+
+    allocate(values(nclen1, nclen2, nclen3))
+    if (nclen1 * nclen2 * nclen3 /= 0) call NF95_GET_VAR(ncid, varid, values)
+
+  end subroutine nf95_gw_var_int_3d
+
+end module nf95_gw_var_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_put_att_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_put_att_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_put_att_m.F90	(revision 1403)
@@ -0,0 +1,67 @@
+! $Id$
+module nf95_put_att_m
+
+  implicit none
+
+  interface nf95_put_att
+     module procedure nf95_put_att_text, nf95_put_att_one_FourByteInt
+  end interface
+
+  private
+  public nf95_put_att
+
+contains
+
+  subroutine nf95_put_att_text(ncid, varid, name, values, ncerr)
+
+    use netcdf, only: nf90_put_att
+    use handle_err_m, only: handle_err
+
+    integer, intent(in) :: ncid, varid
+    character(len = *), intent(in) :: name
+    character(len = *), intent(in) :: values
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_att(ncid, varid, name, values)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_att_text", ncerr_not_opt, ncid, varid)
+    end if
+
+  end subroutine nf95_put_att_text
+
+  !************************************
+
+  subroutine nf95_put_att_one_FourByteInt(ncid, varid, name, values, ncerr)
+
+    use netcdf, only: nf90_put_att
+    use handle_err_m, only: handle_err
+    use typesizes, only: FourByteInt
+
+    integer, intent(in) :: ncid, varid
+    character(len = *), intent(in) :: name
+    integer(kind = FourByteInt), intent(in) :: values
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_att(ncid, varid, name, values)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_att_one_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_att_one_FourByteInt
+
+end module nf95_put_att_m
Index: /trunk/LMDZ.COMMON/libf/misc/nf95_put_var_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/nf95_put_var_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/nf95_put_var_m.F90	(revision 1403)
@@ -0,0 +1,335 @@
+! $Id$
+module nf95_put_var_m
+
+  implicit none
+
+  interface nf95_put_var
+     module procedure nf95_put_var_FourByteReal, nf95_put_var_FourByteInt, &
+          nf95_put_var_1D_FourByteReal, nf95_put_var_1D_FourByteInt, &
+          nf95_put_var_2D_FourByteReal, nf95_put_var_3D_FourByteReal, &
+          nf95_put_var_4D_FourByteReal
+  end interface
+
+  private
+  public nf95_put_var
+
+contains
+
+  subroutine nf95_put_var_FourByteReal(ncid, varid, values, start, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer, intent(in) :: ncid, varid
+    real, intent(in) :: values
+    integer, dimension(:), optional, intent(in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_FourByteInt(ncid, varid, values, start, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer, intent(in) :: ncid, varid
+    integer, intent(in) :: values
+    integer, dimension(:), optional, intent(in) :: start
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_FourByteInt
+
+  !***********************
+
+  subroutine nf95_put_var_1D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real, intent(in) :: values(:)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_1D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_1D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_1D_FourByteInt(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    integer, intent(in) :: values(:)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_1D_FourByteInt", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_1D_FourByteInt
+
+  !***********************
+
+  subroutine nf95_put_var_1D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: eightByteReal
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal),     intent(in) :: values(:)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_1D_eightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_1D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_2D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real, intent(in) :: values(:, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_2D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_2D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_2D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: EightByteReal
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal), intent(in) :: values(:, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_2D_EightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_2D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_3D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real, intent(in) :: values(:, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_3D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_3D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_3D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: eightByteReal
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real (kind = EightByteReal),     intent(in) :: values(:, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_3D_eightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_3D_EightByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_4D_FourByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer,                         intent(in) :: ncid, varid
+    real, intent(in) :: values(:, :, :, :)
+    integer, dimension(:), optional, intent(in) :: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_4D_FourByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_4D_FourByteReal
+
+  !***********************
+
+  subroutine nf95_put_var_4D_EightByteReal(ncid, varid, values, start, &
+       count_nc, stride, map, ncerr)
+
+    use typesizes, only: EightByteReal
+    use netcdf, only: nf90_put_var
+    use handle_err_m, only: handle_err
+
+    integer, intent(in):: ncid, varid
+    real(kind = EightByteReal), intent(in):: values(:, :, :, :)
+    integer, dimension(:), optional, intent(in):: start, count_nc, stride, map
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_put_var(ncid, varid, values, start, count_nc, &
+         stride, map)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_put_var_4D_EightByteReal", ncerr_not_opt, ncid, &
+            varid)
+    end if
+
+  end subroutine nf95_put_var_4D_EightByteReal
+
+end module nf95_put_var_m
Index: /trunk/LMDZ.COMMON/libf/misc/pchdf.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pchdf.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pchdf.F	(revision 1403)
@@ -0,0 +1,106 @@
+*DECK PCHDF
+      REAL FUNCTION PCHDF (K, X, S, IERR)
+C***BEGIN PROLOGUE  PCHDF
+C***SUBSIDIARY
+C***PURPOSE  Computes divided differences for PCHCE and PCHSP
+C***LIBRARY   SLATEC (PCHIP)
+C***TYPE      SINGLE PRECISION (PCHDF-S, DPCHDF-D)
+C***AUTHOR  Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C          PCHDF:   PCHIP Finite Difference Formula
+C
+C     Uses a divided difference formulation to compute a K-point approx-
+C     imation to the derivative at X(K) based on the data in X and S.
+C
+C     Called by  PCHCE  and  PCHSP  to compute 3- and 4-point boundary
+C     derivative approximations.
+C
+C ----------------------------------------------------------------------
+C
+C     On input:
+C        K      is the order of the desired derivative approximation.
+C               K must be at least 3 (error return if not).
+C        X      contains the K values of the independent variable.
+C               X need not be ordered, but the values **MUST** be
+C               distinct.  (Not checked here.)
+C        S      contains the associated slope values:
+C                  S(I) = (F(I+1)-F(I))/(X(I+1)-X(I)), I=1(1)K-1.
+C               (Note that S need only be of length K-1.)
+C
+C     On return:
+C        S      will be destroyed.
+C        IERR   will be set to -1 if K.LT.2 .
+C        PCHDF  will be set to the desired derivative approximation if
+C               IERR=0 or to zero if IERR=-1.
+C
+C ----------------------------------------------------------------------
+C
+C***SEE ALSO  PCHCE, PCHSP
+C***REFERENCES  Carl de Boor, A Practical Guide to Splines, Springer-
+C                 Verlag, New York, 1978, pp. 10-16.
+C***ROUTINES CALLED  XERMSG
+C***REVISION HISTORY  (YYMMDD)
+C   820503  DATE WRITTEN
+C   820805  Converted to SLATEC library version.
+C   870813  Minor cosmetic changes.
+C   890411  Added SAVE statements (Vers. 3.2).
+C   890411  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
+C   900328  Added TYPE section.  (WRB)
+C   910408  Updated AUTHOR and DATE WRITTEN sections in prologue.  (WRB)
+C   920429  Revised format and order of references.  (WRB,FNF)
+C   930503  Improved purpose.  (FNF)
+C***END PROLOGUE  PCHDF
+C
+C**End
+C
+C  DECLARE ARGUMENTS.
+C
+      INTEGER  K, IERR
+      REAL  X(K), S(K)
+C
+C  DECLARE LOCAL VARIABLES.
+C
+      INTEGER  I, J
+      REAL  VALUE, ZERO
+      SAVE ZERO
+      DATA  ZERO /0./
+C
+C  CHECK FOR LEGAL VALUE OF K.
+C
+C***FIRST EXECUTABLE STATEMENT  PCHDF
+      IF (K .LT. 3)  GO TO 5001
+C
+C  COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
+C
+      DO 10  J = 2, K-1
+         DO 9  I = 1, K-J
+            S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
+    9    CONTINUE
+   10 CONTINUE
+C
+C  EVALUATE DERIVATIVE AT X(K).
+C
+      VALUE = S(1)
+      DO 20  I = 2, K-1
+         VALUE = S(I) + VALUE*(X(K)-X(I))
+   20 CONTINUE
+C
+C  NORMAL RETURN.
+C
+      IERR = 0
+      PCHDF = VALUE
+      RETURN
+C
+C  ERROR RETURN.
+C
+ 5001 CONTINUE
+C     K.LT.3 RETURN.
+      IERR = -1
+      CALL XERMSG ('SLATEC', 'PCHDF', 'K LESS THAN THREE', IERR, 1)
+      PCHDF = ZERO
+      RETURN
+C------------- LAST LINE OF PCHDF FOLLOWS ------------------------------
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/pchfe.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pchfe.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pchfe.F	(revision 1403)
@@ -0,0 +1,308 @@
+*DECK PCHFE
+      SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C***BEGIN PROLOGUE  PCHFE
+C***PURPOSE  Evaluate a piecewise cubic Hermite function at an array of
+C            points.  May be used by itself for Hermite interpolation,
+C            or as an evaluator for PCHIM or PCHIC.
+C***LIBRARY   SLATEC (PCHIP)
+C***CATEGORY  E3
+C***TYPE      SINGLE PRECISION (PCHFE-S, DPCHFE-D)
+C***KEYWORDS  CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
+C             PIECEWISE CUBIC EVALUATION
+C***AUTHOR  Fritsch, F. N., (LLNL)
+C             Lawrence Livermore National Laboratory
+C             P.O. Box 808  (L-316)
+C             Livermore, CA  94550
+C             FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C          PCHFE:  Piecewise Cubic Hermite Function Evaluator
+C
+C     Evaluates the cubic Hermite function defined by  N, X, F, D  at
+C     the points  XE(J), J=1(1)NE.
+C
+C     To provide compatibility with PCHIM and PCHIC, includes an
+C     increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C  Calling sequence:
+C
+C        PARAMETER  (INCFD = ...)
+C        INTEGER  N, NE, IERR
+C        REAL  X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE)
+C        LOGICAL  SKIP
+C
+C        CALL  PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C
+C   Parameters:
+C
+C     N -- (input) number of data points.  (Error return if N.LT.2 .)
+C
+C     X -- (input) real array of independent variable values.  The
+C           elements of X must be strictly increasing:
+C                X(I-1) .LT. X(I),  I = 2(1)N.
+C           (Error return if not.)
+C
+C     F -- (input) real array of function values.  F(1+(I-1)*INCFD) is
+C           the value corresponding to X(I).
+C
+C     D -- (input) real array of derivative values.  D(1+(I-1)*INCFD) is
+C           the value corresponding to X(I).
+C
+C     INCFD -- (input) increment between successive values in F and D.
+C           (Error return if  INCFD.LT.1 .)
+C
+C     SKIP -- (input/output) logical variable which should be set to
+C           .TRUE. if the user wishes to skip checks for validity of
+C           preceding parameters, or to .FALSE. otherwise.
+C           This will save time in case these checks have already
+C           been performed (say, in PCHIM or PCHIC).
+C           SKIP will be set to .TRUE. on normal return.
+C
+C     NE -- (input) number of evaluation points.  (Error return if
+C           NE.LT.1 .)
+C
+C     XE -- (input) real array of points at which the function is to be
+C           evaluated.
+C
+C          NOTES:
+C           1. The evaluation will be most efficient if the elements
+C              of XE are increasing relative to X;
+C              that is,   XE(J) .GE. X(I)
+C              implies    XE(K) .GE. X(I),  all K.GE.J .
+C           2. If any of the XE are outside the interval [X(1),X(N)],
+C              values are extrapolated from the nearest extreme cubic,
+C              and a warning error is returned.
+C
+C     FE -- (output) real array of values of the cubic Hermite function
+C           defined by  N, X, F, D  at the points  XE.
+C
+C     IERR -- (output) error flag.
+C           Normal return:
+C              IERR = 0  (no errors).
+C           Warning error:
+C              IERR.GT.0  means that extrapolation was performed at
+C                 IERR points.
+C           "Recoverable" errors:
+C              IERR = -1  if N.LT.2 .
+C              IERR = -2  if INCFD.LT.1 .
+C              IERR = -3  if the X-array is not strictly increasing.
+C              IERR = -4  if NE.LT.1 .
+C             (The FE-array has not been changed in any of these cases.)
+C               NOTE:  The above errors are checked in the order listed,
+C                   and following arguments have **NOT** been validated.
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  CHFEV, XERMSG
+C***REVISION HISTORY  (YYMMDD)
+C   811020  DATE WRITTEN
+C   820803  Minor cosmetic changes for release 1.
+C   870707  Minor cosmetic changes to prologue.
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
+C***END PROLOGUE  PCHFE
+C  Programming notes:
+C
+C     1. To produce a double precision version, simply:
+C        a. Change PCHFE to DPCHFE, and CHFEV to DCHFEV, wherever they
+C           occur,
+C        b. Change the real declaration to double precision,
+C
+C     2. Most of the coding between the call to CHFEV and the end of
+C        the IR-loop could be eliminated if it were permissible to
+C        assume that XE is ordered relative to X.
+C
+C     3. CHFEV does not assume that X1 is less than X2.  thus, it would
+C        be possible to write a version of PCHFE that assumes a strict-
+C        ly decreasing X-array by simply running the IR-loop backwards
+C        (and reversing the order of appropriate tests).
+C
+C     4. The present code has a minor bug, which I have decided is not
+C        worth the effort that would be required to fix it.
+C        If XE contains points in [X(N-1),X(N)], followed by points .LT.
+C        X(N-1), followed by points .GT.X(N), the extrapolation points
+C        will be counted (at least) twice in the total returned in IERR.
+C
+C  DECLARE ARGUMENTS.
+C
+      INTEGER  N, INCFD, NE, IERR
+      REAL  X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*)
+      LOGICAL  SKIP
+C
+C  DECLARE LOCAL VARIABLES.
+C
+      INTEGER  I, IERC, IR, J, JFIRST, NEXT(2), NJ
+C
+C  VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT  PCHFE
+      IF (SKIP)  GO TO 5
+C
+      IF ( N.LT.2 )  GO TO 5001
+      IF ( INCFD.LT.1 )  GO TO 5002
+      DO 1  I = 2, N
+         IF ( X(I).LE.X(I-1) )  GO TO 5003
+    1 CONTINUE
+C
+C  FUNCTION DEFINITION IS OK, GO ON.
+C
+    5 CONTINUE
+      IF ( NE.LT.1 )  GO TO 5004
+      IERR = 0
+      SKIP = .TRUE.
+C
+C  LOOP OVER INTERVALS.        (   INTERVAL INDEX IS  IL = IR-1  . )
+C                              ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
+      JFIRST = 1
+      IR = 2
+   10 CONTINUE
+C
+C     SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
+C
+         IF (JFIRST .GT. NE)  GO TO 5000
+C
+C     LOCATE ALL POINTS IN INTERVAL.
+C
+         DO 20  J = JFIRST, NE
+            IF (XE(J) .GE. X(IR))  GO TO 30
+   20    CONTINUE
+         J = NE + 1
+         GO TO 40
+C
+C     HAVE LOCATED FIRST POINT BEYOND INTERVAL.
+C
+   30    CONTINUE
+         IF (IR .EQ. N)  J = NE + 1
+C
+   40    CONTINUE
+         NJ = J - JFIRST
+C
+C     SKIP EVALUATION IF NO POINTS IN INTERVAL.
+C
+         IF (NJ .EQ. 0)  GO TO 50
+C
+C     EVALUATE CUBIC AT XE(I),  I = JFIRST (1) J-1 .
+C
+C       ----------------------------------------------------------------
+        CALL CHFEV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR),
+     *              NJ, XE(JFIRST), FE(JFIRST), NEXT, IERC)
+C       ----------------------------------------------------------------
+         IF (IERC .LT. 0)  GO TO 5005
+C
+         IF (NEXT(2) .EQ. 0)  GO TO 42
+C        IF (NEXT(2) .GT. 0)  THEN
+C           IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
+C           RIGHT OF X(IR).
+C
+            IF (IR .LT. N)  GO TO 41
+C           IF (IR .EQ. N)  THEN
+C              THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+               IERR = IERR + NEXT(2)
+               GO TO 42
+   41       CONTINUE
+C           ELSE
+C              WE SHOULD NEVER HAVE GOTTEN HERE.
+               GO TO 5005
+C           ENDIF
+C        ENDIF
+   42    CONTINUE
+C
+         IF (NEXT(1) .EQ. 0)  GO TO 49
+C        IF (NEXT(1) .GT. 0)  THEN
+C           IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
+C           LEFT OF X(IR-1).
+C
+            IF (IR .GT. 2)  GO TO 43
+C           IF (IR .EQ. 2)  THEN
+C              THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+               IERR = IERR + NEXT(1)
+               GO TO 49
+   43       CONTINUE
+C           ELSE
+C              XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
+C              EVALUATION INTERVAL.
+C
+C              FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
+               DO 44  I = JFIRST, J-1
+                  IF (XE(I) .LT. X(IR-1))  GO TO 45
+   44          CONTINUE
+C              NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
+C                     IN CHFEV.
+               GO TO 5005
+C
+   45          CONTINUE
+C              RESET J.  (THIS WILL BE THE NEW JFIRST.)
+               J = I
+C
+C              NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
+               DO 46  I = 1, IR-1
+                  IF (XE(J) .LT. X(I)) GO TO 47
+   46          CONTINUE
+C              NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
+C
+   47          CONTINUE
+C              AT THIS POINT, EITHER  XE(J) .LT. X(1)
+C                 OR      X(I-1) .LE. XE(J) .LT. X(I) .
+C              RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
+C              CYCLING.
+               IR = MAX(1, I-1)
+C           ENDIF
+C        ENDIF
+   49    CONTINUE
+C
+         JFIRST = J
+C
+C     END OF IR-LOOP.
+C
+   50 CONTINUE
+      IR = IR + 1
+      IF (IR .LE. N)  GO TO 10
+C
+C  NORMAL RETURN.
+C
+ 5000 CONTINUE
+      RETURN
+C
+C  ERROR RETURNS.
+C
+ 5001 CONTINUE
+C     N.LT.2 RETURN.
+      IERR = -1
+      CALL XERMSG ('SLATEC', 'PCHFE',
+     +   'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+      RETURN
+C
+ 5002 CONTINUE
+C     INCFD.LT.1 RETURN.
+      IERR = -2
+      CALL XERMSG ('SLATEC', 'PCHFE', 'INCREMENT LESS THAN ONE', IERR,
+     +   1)
+      RETURN
+C
+ 5003 CONTINUE
+C     X-ARRAY NOT STRICTLY INCREASING.
+      IERR = -3
+      CALL XERMSG ('SLATEC', 'PCHFE', 'X-ARRAY NOT STRICTLY INCREASING'
+     +   , IERR, 1)
+      RETURN
+C
+ 5004 CONTINUE
+C     NE.LT.1 RETURN.
+      IERR = -4
+      CALL XERMSG ('SLATEC', 'PCHFE',
+     +   'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+      RETURN
+C
+ 5005 CONTINUE
+C     ERROR RETURN FROM CHFEV.
+C   *** THIS CASE SHOULD NEVER OCCUR ***
+      IERR = -5
+      CALL XERMSG ('SLATEC', 'PCHFE',
+     +   'ERROR RETURN FROM CHFEV -- FATAL', IERR, 2)
+      RETURN
+C------------- LAST LINE OF PCHFE FOLLOWS ------------------------------
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/pchfe_95_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pchfe_95_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pchfe_95_m.F90	(revision 1403)
@@ -0,0 +1,76 @@
+module PCHFE_95_m
+
+  implicit none
+
+contains
+
+  SUBROUTINE PCHFE_95(X, F, D, SKIP, XE, FE, IERR)
+
+    ! PURPOSE  Evaluate a piecewise cubic Hermite function at an array of
+    !            points.  May be used by itself for Hermite interpolation,
+    !            or as an evaluator for PCHIM or PCHIC.
+    ! CATEGORY  E3
+    ! KEYWORDS  CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
+    !             PIECEWISE CUBIC EVALUATION
+
+    !          PCHFE:  Piecewise Cubic Hermite Function Evaluator
+    ! Evaluates the cubic Hermite function defined by  X, F, D  at
+    ! the points  XE.
+
+    use assert_eq_m, only: assert_eq
+
+    REAL, intent(in):: X(:) ! real array of independent variable values
+    ! The elements of X must be strictly increasing.
+
+    REAL, intent(in):: F(:) ! real array of function values
+    ! F(I) is the value corresponding to X(I).
+
+    REAL, intent(in):: D(:) ! real array of derivative values
+    ! D(I) is the value corresponding to X(I).
+
+    LOGICAL, intent(inout):: SKIP 
+    ! request to skip checks for validity of "x"
+    ! If "skip" is false then "pchfe" will check that size(x) >= 2 and
+    ! "x" is in strictly ascending order.
+    ! Setting "skip" to true will save time in case these checks have
+    ! already been performed (say, in "PCHIM" or "PCHIC").
+    ! "SKIP" will be set to TRUE on normal return.
+
+    real, intent(in):: XE(:) ! points at which the function is to be evaluated
+    ! NOTES:
+    ! 1. The evaluation will be most efficient if the elements of XE
+    ! are increasing relative to X.
+    ! That is,   XE(J) .GE. X(I)
+    ! implies    XE(K) .GE. X(I),  all K.GE.J
+    ! 2. If any of the XE are outside the interval [X(1),X(N)], values
+    ! are extrapolated from the nearest extreme cubic, and a warning
+    ! error is returned.
+
+    real, intent(out):: FE(:) ! values of the cubic Hermite function
+    ! defined by X, F, D at the points XE
+
+    integer, intent(out):: IERR ! error flag
+    ! Normal return:
+    ! IERR = 0  no error
+    ! Warning error:
+    ! IERR > 0  means that extrapolation was performed at IERR points
+    ! "Recoverable" errors:
+    !              IERR = -1  if N < 2
+    !              IERR = -3  if the X-array is not strictly increasing
+    !              IERR = -4  if NE < 1
+    ! NOTE: The above errors are checked in the order listed, and
+    ! following arguments have **NOT** been validated.
+
+    ! Variables local to the procedure:
+
+    INTEGER  N, NE
+
+    !---------------------------------------
+
+    n = assert_eq(size(x), size(f), size(d), "PCHFE_95 n")
+    ne = assert_eq(size(xe), size(fe), "PCHFE_95 ne")
+    call PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
+
+  end SUBROUTINE PCHFE_95
+
+end module PCHFE_95_m
Index: /trunk/LMDZ.COMMON/libf/misc/pchsp.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pchsp.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pchsp.F	(revision 1403)
@@ -0,0 +1,388 @@
+*DECK PCHSP
+      SUBROUTINE PCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C***BEGIN PROLOGUE  PCHSP
+C***PURPOSE  Set derivatives needed to determine the Hermite represen-
+C            tation of the cubic spline interpolant to given data, with
+C            specified boundary conditions.
+C***LIBRARY   SLATEC (PCHIP)
+C***CATEGORY  E1A
+C***TYPE      SINGLE PRECISION (PCHSP-S, DPCHSP-D)
+C***KEYWORDS  CUBIC HERMITE INTERPOLATION, PCHIP,
+C             PIECEWISE CUBIC INTERPOLATION, SPLINE INTERPOLATION
+C***AUTHOR  Fritsch, F. N., (LLNL)
+C             Lawrence Livermore National Laboratory
+C             P.O. Box 808  (L-316)
+C             Livermore, CA  94550
+C             FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C          PCHSP:   Piecewise Cubic Hermite Spline
+C
+C     Computes the Hermite representation of the cubic spline inter-
+C     polant to the data given in X and F satisfying the boundary
+C     conditions specified by IC and VC.
+C
+C     To facilitate two-dimensional applications, includes an increment
+C     between successive values of the F- and D-arrays.
+C
+C     The resulting piecewise cubic Hermite function may be evaluated
+C     by PCHFE or PCHFD.
+C
+C     NOTE:  This is a modified version of C. de Boor's cubic spline
+C            routine CUBSPL.
+C
+C ----------------------------------------------------------------------
+C
+C  Calling sequence:
+C
+C        PARAMETER  (INCFD = ...)
+C        INTEGER  IC(2), N, NWK, IERR
+C        REAL  VC(2), X(N), F(INCFD,N), D(INCFD,N), WK(NWK)
+C
+C        CALL  PCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C
+C   Parameters:
+C
+C     IC -- (input) integer array of length 2 specifying desired
+C           boundary conditions:
+C           IC(1) = IBEG, desired condition at beginning of data.
+C           IC(2) = IEND, desired condition at end of data.
+C
+C           IBEG = 0  to set D(1) so that the third derivative is con-
+C              tinuous at X(2).  This is the "not a knot" condition
+C              provided by de Boor's cubic spline routine CUBSPL.
+C              < This is the default boundary condition. >
+C           IBEG = 1  if first derivative at X(1) is given in VC(1).
+C           IBEG = 2  if second derivative at X(1) is given in VC(1).
+C           IBEG = 3  to use the 3-point difference formula for D(1).
+C                     (Reverts to the default b.c. if N.LT.3 .)
+C           IBEG = 4  to use the 4-point difference formula for D(1).
+C                     (Reverts to the default b.c. if N.LT.4 .)
+C          NOTES:
+C           1. An error return is taken if IBEG is out of range.
+C           2. For the "natural" boundary condition, use IBEG=2 and
+C              VC(1)=0.
+C
+C           IEND may take on the same values as IBEG, but applied to
+C           derivative at X(N).  In case IEND = 1 or 2, the value is
+C           given in VC(2).
+C
+C          NOTES:
+C           1. An error return is taken if IEND is out of range.
+C           2. For the "natural" boundary condition, use IEND=2 and
+C              VC(2)=0.
+C
+C     VC -- (input) real array of length 2 specifying desired boundary
+C           values, as indicated above.
+C           VC(1) need be set only if IC(1) = 1 or 2 .
+C           VC(2) need be set only if IC(2) = 1 or 2 .
+C
+C     N -- (input) number of data points.  (Error return if N.LT.2 .)
+C
+C     X -- (input) real array of independent variable values.  The
+C           elements of X must be strictly increasing:
+C                X(I-1) .LT. X(I),  I = 2(1)N.
+C           (Error return if not.)
+C
+C     F -- (input) real array of dependent variable values to be inter-
+C           polated.  F(1+(I-1)*INCFD) is value corresponding to X(I).
+C
+C     D -- (output) real array of derivative values at the data points.
+C           These values will determine the cubic spline interpolant
+C           with the requested boundary conditions.
+C           The value corresponding to X(I) is stored in
+C                D(1+(I-1)*INCFD),  I=1(1)N.
+C           No other entries in D are changed.
+C
+C     INCFD -- (input) increment between successive values in F and D.
+C           This argument is provided primarily for 2-D applications.
+C           (Error return if  INCFD.LT.1 .)
+C
+C     WK -- (scratch) real array of working storage.
+C
+C     NWK -- (input) length of work array.
+C           (Error return if NWK.LT.2*N .)
+C
+C     IERR -- (output) error flag.
+C           Normal return:
+C              IERR = 0  (no errors).
+C           "Recoverable" errors:
+C              IERR = -1  if N.LT.2 .
+C              IERR = -2  if INCFD.LT.1 .
+C              IERR = -3  if the X-array is not strictly increasing.
+C              IERR = -4  if IBEG.LT.0 or IBEG.GT.4 .
+C              IERR = -5  if IEND.LT.0 of IEND.GT.4 .
+C              IERR = -6  if both of the above are true.
+C              IERR = -7  if NWK is too small.
+C               NOTE:  The above errors are checked in the order listed,
+C                   and following arguments have **NOT** been validated.
+C             (The D-array has not been changed in any of these cases.)
+C              IERR = -8  in case of trouble solving the linear system
+C                         for the interior derivative values.
+C             (The D-array may have been changed in this case.)
+C             (             Do **NOT** use it!                )
+C
+C***REFERENCES  Carl de Boor, A Practical Guide to Splines, Springer-
+C                 Verlag, New York, 1978, pp. 53-59.
+C***ROUTINES CALLED  PCHDF, XERMSG
+C***REVISION HISTORY  (YYMMDD)
+C   820503  DATE WRITTEN
+C   820804  Converted to SLATEC library version.
+C   870707  Minor cosmetic changes to prologue.
+C   890411  Added SAVE statements (Vers. 3.2).
+C   890703  Corrected category record.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
+C   920429  Revised format and order of references.  (WRB,FNF)
+C***END PROLOGUE  PCHSP
+C  Programming notes:
+C
+C     To produce a double precision version, simply:
+C        a. Change PCHSP to DPCHSP wherever it occurs,
+C        b. Change the real declarations to double precision, and
+C        c. Change the constants ZERO, HALF, ... to double precision.
+C
+C  DECLARE ARGUMENTS.
+C
+      INTEGER  IC(2), N, INCFD, NWK, IERR
+      REAL  VC(2), X(*), F(INCFD,*), D(INCFD,*), WK(2,*)
+C
+C  DECLARE LOCAL VARIABLES.
+C
+      INTEGER  IBEG, IEND, INDEX, J, NM1
+      REAL  G, HALF, ONE, STEMP(3), THREE, TWO, XTEMP(4), ZERO
+      SAVE ZERO, HALF, ONE, TWO, THREE
+      REAL  PCHDF
+C
+      DATA  ZERO /0./,  HALF /0.5/,  ONE /1./,  TWO /2./,  THREE /3./
+C
+C  VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT  PCHSP
+      IF ( N.LT.2 )  GO TO 5001
+      IF ( INCFD.LT.1 )  GO TO 5002
+      DO 1  J = 2, N
+         IF ( X(J).LE.X(J-1) )  GO TO 5003
+    1 CONTINUE
+C
+      IBEG = IC(1)
+      IEND = IC(2)
+      IERR = 0
+      IF ( (IBEG.LT.0).OR.(IBEG.GT.4) )  IERR = IERR - 1
+      IF ( (IEND.LT.0).OR.(IEND.GT.4) )  IERR = IERR - 2
+      IF ( IERR.LT.0 )  GO TO 5004
+C
+C  FUNCTION DEFINITION IS OK -- GO ON.
+C
+      IF ( NWK .LT. 2*N )  GO TO 5007
+C
+C  COMPUTE FIRST DIFFERENCES OF X SEQUENCE AND STORE IN WK(1,.). ALSO,
+C  COMPUTE FIRST DIVIDED DIFFERENCE OF DATA AND STORE IN WK(2,.).
+      DO 5  J=2,N
+         WK(1,J) = X(J) - X(J-1)
+         WK(2,J) = (F(1,J) - F(1,J-1))/WK(1,J)
+    5 CONTINUE
+C
+C  SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
+C
+      IF ( IBEG.GT.N )  IBEG = 0
+      IF ( IEND.GT.N )  IEND = 0
+C
+C  SET UP FOR BOUNDARY CONDITIONS.
+C
+      IF ( (IBEG.EQ.1).OR.(IBEG.EQ.2) )  THEN
+         D(1,1) = VC(1)
+      ELSE IF (IBEG .GT. 2)  THEN
+C        PICK UP FIRST IBEG POINTS, IN REVERSE ORDER.
+         DO 10  J = 1, IBEG
+            INDEX = IBEG-J+1
+C           INDEX RUNS FROM IBEG DOWN TO 1.
+            XTEMP(J) = X(INDEX)
+            IF (J .LT. IBEG)  STEMP(J) = WK(2,INDEX)
+   10    CONTINUE
+C                 --------------------------------
+         D(1,1) = PCHDF (IBEG, XTEMP, STEMP, IERR)
+C                 --------------------------------
+         IF (IERR .NE. 0)  GO TO 5009
+         IBEG = 1
+      ENDIF
+C
+      IF ( (IEND.EQ.1).OR.(IEND.EQ.2) )  THEN
+         D(1,N) = VC(2)
+      ELSE IF (IEND .GT. 2)  THEN
+C        PICK UP LAST IEND POINTS.
+         DO 15  J = 1, IEND
+            INDEX = N-IEND+J
+C           INDEX RUNS FROM N+1-IEND UP TO N.
+            XTEMP(J) = X(INDEX)
+            IF (J .LT. IEND)  STEMP(J) = WK(2,INDEX+1)
+   15    CONTINUE
+C                 --------------------------------
+         D(1,N) = PCHDF (IEND, XTEMP, STEMP, IERR)
+C                 --------------------------------
+         IF (IERR .NE. 0)  GO TO 5009
+         IEND = 1
+      ENDIF
+C
+C --------------------( BEGIN CODING FROM CUBSPL )--------------------
+C
+C  **** A TRIDIAGONAL LINEAR SYSTEM FOR THE UNKNOWN SLOPES S(J) OF
+C  F  AT X(J), J=1,...,N, IS GENERATED AND THEN SOLVED BY GAUSS ELIM-
+C  INATION, WITH S(J) ENDING UP IN D(1,J), ALL J.
+C     WK(1,.) AND WK(2,.) ARE USED FOR TEMPORARY STORAGE.
+C
+C  CONSTRUCT FIRST EQUATION FROM FIRST BOUNDARY CONDITION, OF THE FORM
+C             WK(2,1)*S(1) + WK(1,1)*S(2) = D(1,1)
+C
+      IF (IBEG .EQ. 0)  THEN
+         IF (N .EQ. 2)  THEN
+C           NO CONDITION AT LEFT END AND N = 2.
+            WK(2,1) = ONE
+            WK(1,1) = ONE
+            D(1,1) = TWO*WK(2,2)
+         ELSE
+C           NOT-A-KNOT CONDITION AT LEFT END AND N .GT. 2.
+            WK(2,1) = WK(1,3)
+            WK(1,1) = WK(1,2) + WK(1,3)
+            D(1,1) =((WK(1,2) + TWO*WK(1,1))*WK(2,2)*WK(1,3)
+     *                        + WK(1,2)**2*WK(2,3)) / WK(1,1)
+         ENDIF
+      ELSE IF (IBEG .EQ. 1)  THEN
+C        SLOPE PRESCRIBED AT LEFT END.
+         WK(2,1) = ONE
+         WK(1,1) = ZERO
+      ELSE
+C        SECOND DERIVATIVE PRESCRIBED AT LEFT END.
+         WK(2,1) = TWO
+         WK(1,1) = ONE
+         D(1,1) = THREE*WK(2,2) - HALF*WK(1,2)*D(1,1)
+      ENDIF
+C
+C  IF THERE ARE INTERIOR KNOTS, GENERATE THE CORRESPONDING EQUATIONS AND
+C  CARRY OUT THE FORWARD PASS OF GAUSS ELIMINATION, AFTER WHICH THE J-TH
+C  EQUATION READS    WK(2,J)*S(J) + WK(1,J)*S(J+1) = D(1,J).
+C
+      NM1 = N-1
+      IF (NM1 .GT. 1)  THEN
+         DO 20 J=2,NM1
+            IF (WK(2,J-1) .EQ. ZERO)  GO TO 5008
+            G = -WK(1,J+1)/WK(2,J-1)
+            D(1,J) = G*D(1,J-1)
+     *                  + THREE*(WK(1,J)*WK(2,J+1) + WK(1,J+1)*WK(2,J))
+            WK(2,J) = G*WK(1,J-1) + TWO*(WK(1,J) + WK(1,J+1))
+   20    CONTINUE
+      ENDIF
+C
+C  CONSTRUCT LAST EQUATION FROM SECOND BOUNDARY CONDITION, OF THE FORM
+C           (-G*WK(2,N-1))*S(N-1) + WK(2,N)*S(N) = D(1,N)
+C
+C     IF SLOPE IS PRESCRIBED AT RIGHT END, ONE CAN GO DIRECTLY TO BACK-
+C     SUBSTITUTION, SINCE ARRAYS HAPPEN TO BE SET UP JUST RIGHT FOR IT
+C     AT THIS POINT.
+      IF (IEND .EQ. 1)  GO TO 30
+C
+      IF (IEND .EQ. 0)  THEN
+         IF (N.EQ.2 .AND. IBEG.EQ.0)  THEN
+C           NOT-A-KNOT AT RIGHT ENDPOINT AND AT LEFT ENDPOINT AND N = 2.
+            D(1,2) = WK(2,2)
+            GO TO 30
+         ELSE IF ((N.EQ.2) .OR. (N.EQ.3 .AND. IBEG.EQ.0))  THEN
+C           EITHER (N=3 AND NOT-A-KNOT ALSO AT LEFT) OR (N=2 AND *NOT*
+C           NOT-A-KNOT AT LEFT END POINT).
+            D(1,N) = TWO*WK(2,N)
+            WK(2,N) = ONE
+            IF (WK(2,N-1) .EQ. ZERO)  GO TO 5008
+            G = -ONE/WK(2,N-1)
+         ELSE
+C           NOT-A-KNOT AND N .GE. 3, AND EITHER N.GT.3 OR  ALSO NOT-A-
+C           KNOT AT LEFT END POINT.
+            G = WK(1,N-1) + WK(1,N)
+C           DO NOT NEED TO CHECK FOLLOWING DENOMINATORS (X-DIFFERENCES).
+            D(1,N) = ((WK(1,N)+TWO*G)*WK(2,N)*WK(1,N-1)
+     *                  + WK(1,N)**2*(F(1,N-1)-F(1,N-2))/WK(1,N-1))/G
+            IF (WK(2,N-1) .EQ. ZERO)  GO TO 5008
+            G = -G/WK(2,N-1)
+            WK(2,N) = WK(1,N-1)
+         ENDIF
+      ELSE
+C        SECOND DERIVATIVE PRESCRIBED AT RIGHT ENDPOINT.
+         D(1,N) = THREE*WK(2,N) + HALF*WK(1,N)*D(1,N)
+         WK(2,N) = TWO
+         IF (WK(2,N-1) .EQ. ZERO)  GO TO 5008
+         G = -ONE/WK(2,N-1)
+      ENDIF
+C
+C  COMPLETE FORWARD PASS OF GAUSS ELIMINATION.
+C
+      WK(2,N) = G*WK(1,N-1) + WK(2,N)
+      IF (WK(2,N) .EQ. ZERO)   GO TO 5008
+      D(1,N) = (G*D(1,N-1) + D(1,N))/WK(2,N)
+C
+C  CARRY OUT BACK SUBSTITUTION
+C
+   30 CONTINUE
+      DO 40 J=NM1,1,-1
+         IF (WK(2,J) .EQ. ZERO)  GO TO 5008
+         D(1,J) = (D(1,J) - WK(1,J)*D(1,J+1))/WK(2,J)
+   40 CONTINUE
+C --------------------(  END  CODING FROM CUBSPL )--------------------
+C
+C  NORMAL RETURN.
+C
+      RETURN
+C
+C  ERROR RETURNS.
+C
+ 5001 CONTINUE
+C     N.LT.2 RETURN.
+      IERR = -1
+      CALL XERMSG ('SLATEC', 'PCHSP',
+     +   'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+      RETURN
+C
+ 5002 CONTINUE
+C     INCFD.LT.1 RETURN.
+      IERR = -2
+      CALL XERMSG ('SLATEC', 'PCHSP', 'INCREMENT LESS THAN ONE', IERR,
+     +   1)
+      RETURN
+C
+ 5003 CONTINUE
+C     X-ARRAY NOT STRICTLY INCREASING.
+      IERR = -3
+      CALL XERMSG ('SLATEC', 'PCHSP', 'X-ARRAY NOT STRICTLY INCREASING'
+     +   , IERR, 1)
+      RETURN
+C
+ 5004 CONTINUE
+C     IC OUT OF RANGE RETURN.
+      IERR = IERR - 3
+      CALL XERMSG ('SLATEC', 'PCHSP', 'IC OUT OF RANGE', IERR, 1)
+      RETURN
+C
+ 5007 CONTINUE
+C     NWK TOO SMALL RETURN.
+      IERR = -7
+      CALL XERMSG ('SLATEC', 'PCHSP', 'WORK ARRAY TOO SMALL', IERR, 1)
+      RETURN
+C
+ 5008 CONTINUE
+C     SINGULAR SYSTEM.
+C   *** THEORETICALLY, THIS CAN ONLY OCCUR IF SUCCESSIVE X-VALUES   ***
+C   *** ARE EQUAL, WHICH SHOULD ALREADY HAVE BEEN CAUGHT (IERR=-3). ***
+      IERR = -8
+      CALL XERMSG ('SLATEC', 'PCHSP', 'SINGULAR LINEAR SYSTEM', IERR,
+     +   1)
+      RETURN
+C
+ 5009 CONTINUE
+C     ERROR RETURN FROM PCHDF.
+C   *** THIS CASE SHOULD NEVER OCCUR ***
+      IERR = -9
+      CALL XERMSG ('SLATEC', 'PCHSP', 'ERROR RETURN FROM PCHDF', IERR,
+     +   1)
+      RETURN
+C------------- LAST LINE OF PCHSP FOLLOWS ------------------------------
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/pchsp_95_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pchsp_95_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pchsp_95_m.F90	(revision 1403)
@@ -0,0 +1,116 @@
+module pchsp_95_m
+
+  implicit none
+
+contains
+
+  function pchsp_95(x, f, ibeg, iend, vc_beg, vc_end)
+
+    ! PURPOSE: Set derivatives needed to determine the Hermite
+    ! representation of the cubic spline interpolant to given data,
+    ! with specified boundary conditions.
+
+    ! Part of the "pchip" package.
+
+    ! CATEGORY: E1A
+
+    ! KEYWORDS: cubic hermite interpolation, piecewise cubic
+    ! interpolation, spline interpolation
+
+    ! DESCRIPTION: "pchsp" stands for "Piecewise Cubic Hermite Spline"
+    ! Computes the Hermite representation of the cubic spline
+    ! interpolant to the data given in X and F satisfying the boundary
+    ! conditions specified by Ibeg, iend, vc_beg and VC_end.
+
+    ! The resulting piecewise cubic Hermite function may be evaluated
+    ! by "pchfe" or "pchfd".
+
+    ! NOTE: This is a modified version of C. de Boor's cubic spline
+    ! routine "cubspl".
+
+    ! REFERENCE: Carl de Boor, A Practical Guide to Splines, Springer,
+    ! 2001, pages 43-47
+
+    use assert_eq_m, only: assert_eq
+
+    real, intent(in):: x(:)
+    ! independent variable values
+    ! The elements of X must be strictly increasing:
+    !                X(I-1) < X(I),  I = 2...N.
+    !           (Error return if not.)
+    ! (error if size(x) < 2)
+
+    real, intent(in):: f(:)
+    !     dependent variable values to be interpolated
+    !  F(I) is value corresponding to X(I).
+
+    INTEGER, intent(in):: ibeg
+    !     desired boundary condition at beginning of data
+
+    !        IBEG = 0  to set pchsp_95(1) so that the third derivative is con-
+    !              tinuous at X(2).  This is the "not a knot" condition
+    !              provided by de Boor's cubic spline routine CUBSPL.
+    !              This is the default boundary condition.
+    !        IBEG = 1  if first derivative at X(1) is given in VC_BEG.
+    !        IBEG = 2  if second derivative at X(1) is given in VC_BEG.
+    !        IBEG = 3  to use the 3-point difference formula for pchsp_95(1).
+    !              (Reverts to the default boundary condition if size(x) < 3 .)
+    !        IBEG = 4  to use the 4-point difference formula for pchsp_95(1).
+    !              (Reverts to the default boundary condition if size(x) < 4 .)
+
+    !          NOTES:
+    !           1. An error return is taken if IBEG is out of range.
+    !           2. For the "natural" boundary condition, use IBEG=2 and
+    !              VC_BEG=0.
+
+    INTEGER, intent(in):: iend
+    !           IC(2) = IEND, desired condition at end of data.
+    !  IEND may take on the same values as IBEG, but applied to
+    !  derivative at X(N). In case IEND = 1 or 2, The value is given in VC_END.
+
+    !          NOTES:
+    !           1. An error return is taken if IEND is out of range.
+    !           2. For the "natural" boundary condition, use IEND=2 and
+    !              VC_END=0.
+
+    REAL, intent(in), optional:: vc_beg
+    ! desired boundary value, as indicated above.
+    !           VC_BEG need be set only if IBEG = 1 or 2 .
+
+    REAL, intent(in), optional:: vc_end
+    ! desired boundary value, as indicated above.
+    !           VC_END need be set only if Iend = 1 or 2 .
+
+    real pchsp_95(size(x))
+    ! derivative values at the data points
+    !           These values will determine the cubic spline interpolant
+    !           with the requested boundary conditions.
+    !           The value corresponding to X(I) is stored in
+    !                PCHSP_95(I),  I=1...N.
+
+    ! LOCAL VARIABLES:
+    real wk(2, size(x)) ! real array of working storage
+    INTEGER n ! number of data points
+    integer ierr, ic(2)
+    real vc(2)
+
+    !-------------------------------------------------------------------
+
+    n = assert_eq(size(x), size(f), "pchsp_95 n")
+    if ((ibeg == 1 .or. ibeg == 2) .and. .not. present(vc_beg)) then
+       print *, "vc_beg required for IBEG = 1 or 2"
+       stop 1
+    end if
+    if ((iend == 1 .or. iend == 2) .and. .not. present(vc_end)) then
+       print *, "vc_end required for IEND = 1 or 2"
+       stop 1
+    end if
+    ic = (/ibeg, iend/)
+    if (present(vc_beg)) vc(1) = vc_beg
+    if (present(vc_end)) vc(2) = vc_end
+    call PCHSP(IC, VC, N, X, F, pchsp_95, 1, WK, size(WK), IERR)
+    if (ierr /= 0) stop 1
+
+  END function pchsp_95
+
+end module pchsp_95_m
Index: /trunk/LMDZ.COMMON/libf/misc/pres2lev_mod.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/pres2lev_mod.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/pres2lev_mod.F90	(revision 1403)
@@ -0,0 +1,79 @@
+! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
+!
+MODULE pres2lev_mod
+
+CONTAINS 
+
+!******************************************************
+SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
+!
+! interpolation lineaire pour passer
+! a une nouvelle discretisation verticale pour
+! les variables de GCM
+! Francois Forget (01/1995)
+! MOdif remy roca 12/97 pour passer de pres2sig
+! Modif F.Codron 07/08 po en 3D
+!**********************************************************
+
+  IMPLICIT NONE
+
+!   Declarations:
+! ==============
+!
+!  ARGUMENTS
+!  """""""""
+  LOGICAL, INTENT(IN) :: ok_invertp
+  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
+  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
+  
+  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
+  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
+  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
+
+  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
+  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
+
+  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
+
+! Autres variables
+! """"""""""""""""
+  INTEGER ::  ln ,lo, k
+  REAL    :: coef
+
+
+! Inversion de l'ordre des niveaux verticaux
+  IF (ok_invertp) THEN
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lmo+1-lo)
+        zvaro(k,lo)=varo(k,lmo+1-lo)
+      ENDDO
+    ENDDO
+  ELSE
+    DO lo=1,lmo
+      DO k=1,ni*nj
+        zpo(k,lo)=po(k,lo)
+        zvaro(k,lo)=varo(k,lo)
+      ENDDO
+    ENDDO
+  ENDIF 
+
+  DO ln=1,lmn
+    DO lo=1,lmo-1
+      DO k=1,ni*nj
+        IF (pn(k,ln) >= zpo(k,1) ) THEN
+          varn(k,ln) = zvaro(k,1)
+        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
+          varn(k,ln) = zvaro(k,lmo)
+        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
+          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
+          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
+        ENDIF
+         
+      ENDDO  
+    ENDDO
+  ENDDO                
+
+END SUBROUTINE pres2lev    
+
+END MODULE pres2lev_mod
Index: /trunk/LMDZ.COMMON/libf/misc/regr1_lint_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/regr1_lint_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/regr1_lint_m.F90	(revision 1403)
@@ -0,0 +1,98 @@
+! $Id$
+module regr1_lint_m
+
+  ! Author: Lionel GUEZ
+
+  implicit none
+
+  interface regr1_lint
+     ! Each procedure regrids by linear interpolation.
+     ! The regridding operation is done on the first dimension of the
+     ! input array.
+     ! The difference betwwen the procedures is the rank of the first argument.
+     module procedure regr11_lint, regr12_lint
+  end interface
+
+  private
+  public regr1_lint
+
+contains
+
+  function regr11_lint(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 1.
+
+    use assert_eq_m, only: assert_eq
+    use interpolation, only: hunt !!, polint
+
+    real, intent(in):: vs(:)
+    ! (values of the function at source points "xs")
+
+    real, intent(in):: xs(:)
+    ! (abscissas of points in source grid, in strictly monotonic order)
+
+    real, intent(in):: xt(:)
+    ! (abscissas of points in target grid)
+
+    real vt(size(xt)) ! values of the function on the target grid
+
+    ! Variables local to the procedure:
+    integer is, it, ns
+    integer is_b ! "is" bound between 1 and "ns - 1"
+
+    !--------------------------------------
+
+    ns = assert_eq(size(vs), size(xs), "regr11_lint ns")
+
+    is = -1 ! go immediately to bisection on first call to "hunt"
+
+    do it = 1, size(xt)
+       call hunt(xs, xt(it), is)
+       is_b = min(max(is, 1), ns - 1)
+!!       call polint(xs(is_b:is_b+1), vs(is_b:is_b+1), xt(it), vt(it))
+       vt(it) = ((xs(is_b+1) - xt(it)) * vs(is_b) &
+            + (xt(it) - xs(is_b)) * vs(is_b+1)) / (xs(is_b+1) - xs(is_b))
+    end do
+
+  end function regr11_lint
+
+  !*********************************************************
+
+  function regr12_lint(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 2.
+
+    use assert_eq_m, only: assert_eq
+    use interpolation, only: hunt
+
+    real, intent(in):: vs(:, :)
+    ! (values of the function at source points "xs")
+
+    real, intent(in):: xs(:)
+    ! (abscissas of points in source grid, in strictly monotonic order)
+
+    real, intent(in):: xt(:)
+    ! (abscissas of points in target grid)
+
+    real vt(size(xt), size(vs, 2)) ! values of the function on the target grid
+
+    ! Variables local to the procedure:
+    integer is, it, ns
+    integer is_b ! "is" bound between 1 and "ns - 1"
+
+    !--------------------------------------
+
+    ns = assert_eq(size(vs, 1), size(xs), "regr12_lint ns")
+
+    is = -1 ! go immediately to bisection on first call to "hunt"
+
+    do it = 1, size(xt)
+       call hunt(xs, xt(it), is)
+       is_b = min(max(is, 1), ns - 1)
+       vt(it, :) = ((xs(is_b+1) - xt(it)) * vs(is_b, :) &
+            + (xt(it) - xs(is_b)) * vs(is_b+1, :)) / (xs(is_b+1) - xs(is_b))
+    end do
+
+  end function regr12_lint
+
+end module regr1_lint_m
Index: /trunk/LMDZ.COMMON/libf/misc/regr1_step_av_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/regr1_step_av_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/regr1_step_av_m.F90	(revision 1403)
@@ -0,0 +1,268 @@
+! $Id$
+module regr1_step_av_m
+
+  ! Author: Lionel GUEZ
+
+  implicit none
+
+  interface regr1_step_av
+
+     ! Each procedure regrids a step function by averaging it.
+     ! The regridding operation is done on the first dimension of the
+     ! input array.
+     ! Source grid contains edges of steps.
+     ! Target grid contains positions of cell edges.
+     ! The target grid should be included in the source grid: no
+     ! extrapolation is allowed.
+     ! The difference between the procedures is the rank of the first argument.
+
+     module procedure regr11_step_av, regr12_step_av, regr13_step_av, &
+          regr14_step_av
+  end interface
+
+  private
+  public regr1_step_av
+
+contains
+
+  function regr11_step_av(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 1.
+
+    use assert_eq_m, only: assert_eq
+    use assert_m, only: assert
+    use interpolation, only: locate
+
+    real, intent(in):: vs(:) ! values of steps on the source grid
+    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
+
+    real, intent(in):: xs(:)
+    ! (edges of of steps on the source grid, in strictly increasing order)
+
+    real, intent(in):: xt(:)
+    ! (edges of cells of the target grid, in strictly increasing order)
+
+    real vt(size(xt) - 1) ! average values on the target grid
+    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
+
+    ! Variables local to the procedure:
+    integer is, it, ns, nt
+    real left_edge
+
+    !---------------------------------------------
+
+    ns = assert_eq(size(vs), size(xs) - 1, "regr11_step_av ns")
+    nt = size(xt) - 1
+    ! Quick check on sort order:
+    call assert(xs(1) < xs(2), "regr11_step_av xs bad order")
+    call assert(xt(1) < xt(2), "regr11_step_av xt bad order")
+
+    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+         "regr11_step_av extrapolation")
+
+    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+    do it = 1, nt
+       ! 1 <= is <= ns
+       ! xs(is) <= xt(it) < xs(is + 1)
+       ! Compute "vt(it)":
+       left_edge = xt(it)
+       vt(it) = 0.
+       do while (xs(is + 1) < xt(it + 1))
+          ! 1 <= is <= ns - 1
+          vt(it) = vt(it) + (xs(is + 1) - left_edge) * vs(is)
+          is = is + 1
+          left_edge = xs(is)
+       end do
+       ! 1 <= is <= ns
+       vt(it) = (vt(it) + (xt(it + 1) - left_edge) * vs(is)) &
+            / (xt(it + 1) - xt(it))
+       if (xs(is + 1) == xt(it + 1)) is = is + 1
+       ! 1 <= is <= ns .or. it == nt
+    end do
+
+  end function regr11_step_av
+
+  !********************************************
+
+  function regr12_step_av(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 2.
+
+    use assert_eq_m, only: assert_eq
+    use assert_m, only: assert
+    use interpolation, only: locate
+
+    real, intent(in):: vs(:, :) ! values of steps on the source grid
+    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
+
+    real, intent(in):: xs(:)
+    ! (edges of steps on the source grid, in strictly increasing order)
+
+    real, intent(in):: xt(:)
+    ! (edges of cells of the target grid, in strictly increasing order)
+
+    real vt(size(xt) - 1, size(vs, 2)) ! average values on the target grid
+    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
+
+    ! Variables local to the procedure:
+    integer is, it, ns, nt
+    real left_edge
+
+    !---------------------------------------------
+
+    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr12_step_av ns")
+    nt = size(xt) - 1
+
+    ! Quick check on sort order:
+    call assert(xs(1) < xs(2), "regr12_step_av xs bad order")
+    call assert(xt(1) < xt(2), "regr12_step_av xt bad order")
+
+    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+         "regr12_step_av extrapolation")
+
+    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+    do it = 1, nt
+       ! 1 <= is <= ns
+       ! xs(is) <= xt(it) < xs(is + 1)
+       ! Compute "vt(it, :)":
+       left_edge = xt(it)
+       vt(it, :) = 0.
+       do while (xs(is + 1) < xt(it + 1))
+          ! 1 <= is <= ns - 1
+          vt(it, :) = vt(it, :) + (xs(is + 1) - left_edge) * vs(is, :)
+          is = is + 1
+          left_edge = xs(is)
+       end do
+       ! 1 <= is <= ns
+       vt(it, :) = (vt(it, :) + (xt(it + 1) - left_edge) * vs(is, :)) &
+            / (xt(it + 1) - xt(it))
+       if (xs(is + 1) == xt(it + 1)) is = is + 1
+       ! 1 <= is <= ns .or. it == nt
+    end do
+
+  end function regr12_step_av
+
+  !********************************************
+
+  function regr13_step_av(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 3.
+
+    use assert_eq_m, only: assert_eq
+    use assert_m, only: assert
+    use interpolation, only: locate
+
+    real, intent(in):: vs(:, :, :) ! values of steps on the source grid
+    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
+
+    real, intent(in):: xs(:)
+    ! (edges of steps on the source grid, in strictly increasing order)
+
+    real, intent(in):: xt(:)
+    ! (edges of cells of the target grid, in strictly increasing order)
+
+    real vt(size(xt) - 1, size(vs, 2), size(vs, 3)) 
+    ! (average values on the target grid)
+    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
+
+    ! Variables local to the procedure:
+    integer is, it, ns, nt
+    real left_edge
+
+    !---------------------------------------------
+
+    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr13_step_av ns")
+    nt = size(xt) - 1
+
+    ! Quick check on sort order:
+    call assert(xs(1) < xs(2), "regr13_step_av xs bad order")
+    call assert(xt(1) < xt(2), "regr13_step_av xt bad order")
+
+    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+         "regr13_step_av extrapolation")
+
+    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+    do it = 1, nt
+       ! 1 <= is <= ns
+       ! xs(is) <= xt(it) < xs(is + 1)
+       ! Compute "vt(it, :, :)":
+       left_edge = xt(it)
+       vt(it, :, :) = 0.
+       do while (xs(is + 1) < xt(it + 1))
+          ! 1 <= is <= ns - 1
+          vt(it, :, :) = vt(it, :, :) + (xs(is + 1) - left_edge) * vs(is, :, :)
+          is = is + 1
+          left_edge = xs(is)
+       end do
+       ! 1 <= is <= ns
+       vt(it, :, :) = (vt(it, :, :) &
+            + (xt(it + 1) - left_edge) * vs(is, :, :)) / (xt(it + 1) - xt(it))
+       if (xs(is + 1) == xt(it + 1)) is = is + 1
+       ! 1 <= is <= ns .or. it == nt
+    end do
+
+  end function regr13_step_av
+
+  !********************************************
+
+  function regr14_step_av(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 4.
+
+    use assert_eq_m, only: assert_eq
+    use assert_m, only: assert
+    use interpolation, only: locate
+
+    real, intent(in):: vs(:, :, :, :) ! values of steps on the source grid
+    ! (Step "is" is between "xs(is)" and "xs(is + 1)".)
+
+    real, intent(in):: xs(:)
+    ! (edges of steps on the source grid, in strictly increasing order)
+
+    real, intent(in):: xt(:)
+    ! (edges of cells of the target grid, in strictly increasing order)
+
+    real vt(size(xt) - 1, size(vs, 2), size(vs, 3), size(vs, 4))
+    ! (average values on the target grid)
+    ! (Cell "it" is between "xt(it)" and "xt(it + 1)".)
+
+    ! Variables local to the procedure:
+    integer is, it, ns, nt
+    real left_edge
+
+    !---------------------------------------------
+
+    ns = assert_eq(size(vs, 1), size(xs) - 1, "regr14_step_av ns")
+    nt = size(xt) - 1
+
+    ! Quick check on sort order:
+    call assert(xs(1) < xs(2), "regr14_step_av xs bad order")
+    call assert(xt(1) < xt(2), "regr14_step_av xt bad order")
+
+    call assert(xs(1) <= xt(1) .and. xt(nt + 1) <= xs(ns + 1), &
+         "regr14_step_av extrapolation")
+
+    is = locate(xs, xt(1)) ! 1 <= is <= ns, because we forbid extrapolation
+    do it = 1, nt
+       ! 1 <= is <= ns
+       ! xs(is) <= xt(it) < xs(is + 1)
+       ! Compute "vt(it, :, :, :)":
+       left_edge = xt(it)
+       vt(it, :, :, :) = 0.
+       do while (xs(is + 1) < xt(it + 1))
+          ! 1 <= is <= ns - 1
+          vt(it, :, :, :) = vt(it, :, :, :) + (xs(is + 1) - left_edge) &
+               * vs(is, :, :, :)
+          is = is + 1
+          left_edge = xs(is)
+       end do
+       ! 1 <= is <= ns
+       vt(it, :, :, :) = (vt(it, :, :, :) + (xt(it + 1) - left_edge) &
+            * vs(is, :, :, :)) / (xt(it + 1) - xt(it))
+       if (xs(is + 1) == xt(it + 1)) is = is + 1
+       ! 1 <= is <= ns .or. it == nt
+    end do
+
+  end function regr14_step_av
+
+end module regr1_step_av_m
Index: /trunk/LMDZ.COMMON/libf/misc/regr3_lint_m.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/regr3_lint_m.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/regr3_lint_m.F90	(revision 1403)
@@ -0,0 +1,100 @@
+! $Id$
+module regr3_lint_m
+
+  ! Author: Lionel GUEZ
+
+  implicit none
+
+  interface regr3_lint
+     ! Each procedure regrids by linear interpolation.
+     ! The regridding operation is done on the third dimension of the
+     ! input array.
+     ! The difference betwwen the procedures is the rank of the first argument.
+     module procedure regr33_lint, regr34_lint
+  end interface
+
+  private
+  public regr3_lint
+
+contains
+
+  function regr33_lint(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 3.
+
+    use assert_eq_m, only: assert_eq
+    use interpolation, only: hunt
+
+    real, intent(in):: vs(:, :, :)
+    ! (values of the function at source points "xs")
+
+    real, intent(in):: xs(:)
+    ! (abscissas of points in source grid, in strictly monotonic order)
+
+    real, intent(in):: xt(:)
+    ! (abscissas of points in target grid)
+
+    real vt(size(vs, 1), size(vs, 2), size(xt))
+    ! (values of the function on the target grid)
+
+    ! Variables local to the procedure:
+    integer is, it, ns
+    integer is_b ! "is" bound between 1 and "ns - 1"
+
+    !--------------------------------------
+
+    ns = assert_eq(size(vs, 3), size(xs), "regr33_lint ns")
+
+    is = -1 ! go immediately to bisection on first call to "hunt"
+
+    do it = 1, size(xt)
+       call hunt(xs, xt(it), is)
+       is_b = min(max(is, 1), ns - 1)
+       vt(:, :, it) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b) &
+            + (xt(it) - xs(is_b)) * vs(:, :, is_b+1)) / (xs(is_b+1) - xs(is_b))
+    end do
+
+  end function regr33_lint
+
+  !*********************************************************
+
+  function regr34_lint(vs, xs, xt) result(vt)
+
+    ! "vs" has rank 4.
+
+    use assert_eq_m, only: assert_eq
+    use interpolation, only: hunt
+
+    real, intent(in):: vs(:, :, :, :)
+    ! (values of the function at source points "xs")
+
+    real, intent(in):: xs(:)
+    ! (abscissas of points in source grid, in strictly monotonic order)
+
+    real, intent(in):: xt(:)
+    ! (abscissas of points in target grid)
+
+    real vt(size(vs, 1), size(vs, 2), size(xt), size(vs, 4))
+    ! (values of the function on the target grid)
+
+    ! Variables local to the procedure:
+    integer is, it, ns
+    integer is_b ! "is" bound between 1 and "ns - 1"
+
+    !--------------------------------------
+
+    ns = assert_eq(size(vs, 3), size(xs), "regr34_lint ns")
+
+    is = -1 ! go immediately to bisection on first call to "hunt"
+
+    do it = 1, size(xt)
+       call hunt(xs, xt(it), is)
+       is_b = min(max(is, 1), ns - 1)
+       vt(:, :, it, :) = ((xs(is_b+1) - xt(it)) * vs(:, :, is_b, :) &
+            + (xt(it) - xs(is_b)) * vs(:, :, is_b+1, :)) &
+            / (xs(is_b+1) - xs(is_b))
+    end do
+
+  end function regr34_lint
+
+end module regr3_lint_m
Index: /trunk/LMDZ.COMMON/libf/misc/simple.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/simple.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/simple.F90	(revision 1403)
@@ -0,0 +1,361 @@
+! $Id$
+module simple
+
+  use handle_err_m, only: handle_err
+  
+  implicit none
+
+  private handle_err
+
+contains
+
+  subroutine nf95_open(path, mode, ncid, chunksize, ncerr)
+
+    use netcdf, only: nf90_open
+
+    character(len=*), intent(in):: path
+    integer, intent(in):: mode
+    integer, intent(out):: ncid
+    integer, intent(inout), optional:: chunksize
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_open(path, mode, ncid, chunksize)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_open " // path, ncerr_not_opt)
+    end if
+
+  end subroutine nf95_open
+
+  !************************
+
+  subroutine nf95_inq_dimid(ncid, name, dimid, ncerr)
+
+    use netcdf, only: nf90_inq_dimid
+
+    integer,             intent(in) :: ncid
+    character (len = *), intent(in) :: name
+    integer,             intent(out) :: dimid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_inq_dimid(ncid, name, dimid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inq_dimid " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_inq_dimid
+
+  !************************
+
+  subroutine nf95_inquire_dimension(ncid, dimid, name, nclen, ncerr)
+
+    use netcdf, only: nf90_inquire_dimension
+
+    integer,                       intent( in) :: ncid, dimid
+    character (len = *), optional, intent(out) :: name
+    integer,             optional, intent(out) :: nclen
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, nclen)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inquire_dimension", ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_inquire_dimension
+
+  !************************
+
+  subroutine nf95_inq_varid(ncid, name, varid, ncerr)
+
+    use netcdf, only: nf90_inq_varid
+
+    integer,             intent(in) :: ncid
+    character(len=*), intent(in):: name
+    integer,             intent(out) :: varid
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_inq_varid(ncid, name, varid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inq_varid, name = " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_inq_varid
+
+  !************************
+
+  subroutine nf95_inquire_variable(ncid, varid, name, xtype, ndims, dimids, &
+       nAtts, ncerr)
+
+    ! In "nf90_inquire_variable", "dimids" is an assumed-size array.
+    ! This is not optimal.
+    ! We are in the classical case of an array the size of which is
+    ! unknown in the calling procedure, before the call.
+    ! Here we use a better solution: a pointer argument array.
+    ! This procedure associates and defines "dimids" if it is present.
+
+    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
+
+    integer, intent(in):: ncid, varid
+    character(len = *), optional, intent(out):: name
+    integer, optional, intent(out) :: xtype, ndims
+    integer, dimension(:), optional, pointer :: dimids
+    integer, optional, intent(out) :: nAtts
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+    integer dimids_local(nf90_max_var_dims)
+    integer ndims_not_opt
+
+    !-------------------
+
+    if (present(dimids)) then
+       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, &
+            ndims_not_opt, dimids_local, nAtts)
+       allocate(dimids(ndims_not_opt)) ! also works if ndims_not_opt == 0
+       dimids = dimids_local(:ndims_not_opt)
+       if (present(ndims)) ndims = ndims_not_opt
+    else
+       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, ndims, &
+            nAtts=nAtts)
+    end if
+
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid, varid)
+    end if
+
+  end subroutine nf95_inquire_variable
+
+  !************************
+
+  subroutine nf95_create(path, cmode, ncid, initialsize, chunksize, ncerr)
+    
+    use netcdf, only: nf90_create
+
+    character (len = *), intent(in   ) :: path
+    integer,             intent(in   ) :: cmode
+    integer,             intent(  out) :: ncid
+    integer, optional,   intent(in   ) :: initialsize
+    integer, optional,   intent(inout) :: chunksize
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_create(path, cmode, ncid, initialsize, chunksize)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_create " // path, ncerr_not_opt)
+    end if
+
+  end subroutine nf95_create
+
+  !************************
+
+  subroutine nf95_def_dim(ncid, name, nclen, dimid, ncerr)
+
+    use netcdf, only: nf90_def_dim
+
+    integer,             intent( in) :: ncid
+    character (len = *), intent( in) :: name
+    integer,             intent( in) :: nclen
+    integer,             intent(out) :: dimid
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_def_dim(ncid, name, nclen, dimid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_def_dim " // name, ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_def_dim
+
+  !***********************
+
+  subroutine nf95_redef(ncid, ncerr)
+
+    use netcdf, only: nf90_redef
+
+    integer, intent( in) :: ncid
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_redef(ncid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_redef", ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_redef
+  
+  !***********************
+
+  subroutine nf95_enddef(ncid, h_minfree, v_align, v_minfree, r_align, ncerr)
+
+    use netcdf, only: nf90_enddef
+
+    integer,           intent( in) :: ncid
+    integer, optional, intent( in) :: h_minfree, v_align, v_minfree, r_align
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_enddef(ncid, h_minfree, v_align, v_minfree, r_align)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_enddef", ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_enddef
+
+  !***********************
+
+  subroutine nf95_close(ncid, ncerr)
+
+    use netcdf, only: nf90_close
+
+    integer, intent( in) :: ncid
+    integer, intent(out), optional :: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_close(ncid)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_close", ncerr_not_opt)
+    end if
+
+  end subroutine nf95_close
+
+  !***********************
+
+  subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr)
+
+    use netcdf, only: nf90_copy_att
+
+    integer, intent( in):: ncid_in,  varid_in
+    character(len=*), intent( in):: name
+    integer, intent( in):: ncid_out, varid_out
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_copy_att(ncid_in, varid_in, name, ncid_out, varid_out)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_copy_att " // name, ncerr_not_opt, ncid_out)
+    end if
+
+  end subroutine nf95_copy_att
+
+  !***********************
+
+  subroutine nf95_inquire_attribute(ncid, varid, name, xtype, nclen, attnum, &
+       ncerr)
+
+    use netcdf, only: nf90_inquire_attribute
+
+    integer,             intent( in)           :: ncid, varid
+    character (len = *), intent( in)           :: name
+    integer,             intent(out), optional :: xtype, nclen, attnum
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_inquire_attribute(ncid, varid, name, xtype, nclen, &
+         attnum)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inquire_attribute " // name, ncerr_not_opt, &
+            ncid, varid)
+    end if
+
+  end subroutine nf95_inquire_attribute
+
+  !***********************
+
+  subroutine nf95_inquire(ncid, nDimensions, nVariables, nAttributes, &
+       unlimitedDimId, formatNum, ncerr)
+
+    use netcdf, only: nf90_inquire
+
+    integer,           intent( in) :: ncid
+    integer, optional, intent(out) :: nDimensions, nVariables, nAttributes
+    integer, optional, intent(out) :: unlimitedDimId, formatNum
+    integer, intent(out), optional:: ncerr
+
+    ! Variable local to the procedure:
+    integer ncerr_not_opt
+
+    !-------------------
+
+    ncerr_not_opt = nf90_inquire(ncid, nDimensions, nVariables, nAttributes, &
+         unlimitedDimId, formatNum)
+    if (present(ncerr)) then
+       ncerr = ncerr_not_opt
+    else
+       call handle_err("nf95_inquire", ncerr_not_opt, ncid)
+    end if
+
+  end subroutine nf95_inquire
+
+end module simple
Index: /trunk/LMDZ.COMMON/libf/misc/vampir.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/vampir.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/vampir.F90	(revision 1403)
@@ -0,0 +1,86 @@
+module Vampir
+
+  INTEGER,parameter :: VTcaldyn=1
+  INTEGER,parameter :: VTintegre=2
+  INTEGER,parameter :: VTadvection=3
+  INTEGER,parameter :: VTdissipation=4
+  INTEGER,parameter :: VThallo=5
+  INTEGER,parameter :: VTphysiq=6
+  INTEGER,parameter :: VTinca=7
+  
+  INTEGER,parameter :: nb_inst=7
+  INTEGER :: MPE_begin(nb_inst)
+  INTEGER :: MPE_end(nb_inst)
+  
+contains
+
+  subroutine InitVampir
+    implicit none
+
+#ifdef USE_VT
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTSYMDEF(VTcaldyn,"caldyn","caldyn",ierr)
+    call VTSYMDEF(VTintegre,"integre","integre",ierr)
+    call VTSYMDEF(VTadvection,"advection","advection",ierr)
+    call VTSYMDEF(VTdissipation,"dissipation","dissipation",ierr)
+    call VTSYMDEF(VThallo,"hallo","hallo",ierr)
+    call VTSYMDEF(VTphysiq,"physiq","physiq",ierr)
+    call VTSYMDEF(VTinca,"inca","inca",ierr)
+#endif
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    
+    DO i=1,nb_inst
+      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
+    ENDDO
+    
+    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
+    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
+    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
+    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
+    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
+    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
+    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
+#endif     
+  end subroutine InitVampir
+
+  subroutine VTb(number)
+    implicit none
+    INTEGER :: number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTBEGIN(number,ierr)
+#endif 
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
+#endif
+
+  end subroutine VTb
+
+  subroutine VTe(number)
+    implicit none
+    INTEGER :: Number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+   
+    call VTEND(number,ierr)
+#endif    
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_end(number), 0, '' )
+#endif
+
+  end subroutine VTe
+  
+end module Vampir
Index: /trunk/LMDZ.COMMON/libf/misc/wxios.F90
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/wxios.F90	(revision 1403)
@@ -0,0 +1,561 @@
+! $Id: wxios.F90 $
+#ifdef CPP_XIOS
+MODULE wxios
+    USE xios
+    USE iaxis
+    USE iaxis_attr
+    USE icontext_attr
+    USE idate
+    USE idomain_attr
+    USE ifield_attr
+    USE ifile_attr
+    USE ixml_tree
+
+    !Variables disponibles pendant toute l'execution du programme:
+    
+    INTEGER, SAVE :: g_comm
+    CHARACTER(len=100), SAVE :: g_ctx_name
+    TYPE(xios_context), SAVE :: g_ctx
+!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
+    LOGICAL, SAVE :: g_flag_xml = .FALSE.
+    CHARACTER(len=100) :: g_field_name = "nofield"
+!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
+
+
+    CONTAINS
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    SUBROUTINE reformadate(odate, ndate)
+        CHARACTER(len=*), INTENT(IN) :: odate
+        CHARACTER(len=100), INTENT(OUT) :: ndate
+        
+        INTEGER :: i = 0
+         !!!!!!!!!!!!!!!!!!
+         ! Pour XIOS:
+         !  year : y
+         !  month : mo
+         !  day : d
+         !  hour : h
+         !  minute : mi
+         !  second : s
+         !!!!!!!!!!!!!!!!!!
+
+        i = INDEX(odate, "day")
+        IF (i > 0) THEN
+            ndate = odate(1:i-1)//"d"
+        END IF
+
+        i = INDEX(odate, "hr")
+        IF (i > 0) THEN
+            ndate = odate(1:i-1)//"h"
+        END IF
+
+        i = INDEX(odate, "mth")
+        IF (i > 0) THEN
+            ndate = odate(1:i-1)//"mo"
+        END IF
+        
+        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
+    END SUBROUTINE reformadate
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   ave(X) => average etc     !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    CHARACTER(len=7) FUNCTION reformaop(op)
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        INTEGER :: i = 0
+        reformaop = "average"
+        
+        IF (op.EQ."inst(X)") THEN
+            reformaop = "instant"
+        END IF
+        
+        IF (op.EQ."once") THEN
+            reformaop = "once"
+        END IF
+        
+        IF (op.EQ."t_max(X)") THEN
+            reformaop = "maximum"
+        END IF
+        
+        IF (op.EQ."t_min(X)") THEN
+            reformaop = "minimum"
+        END IF
+        
+        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
+    END FUNCTION reformaop
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine d'initialisation      !!!!!!!!!!!!!
+    !     A lancer juste aprÃ¨s mpi_init !!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
+      INTEGER, INTENT(IN), OPTIONAL :: locom
+      INTEGER, INTENT(OUT), OPTIONAL :: outcom
+      CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
+
+    
+        TYPE(xios_context) :: xios_ctx
+        INTEGER :: xios_comm
+
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
+
+
+
+        IF (PRESENT(locom)) THEN
+          CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
+        ELSE
+          CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
+        END IF
+        
+        IF (PRESENT(outcom)) THEN
+          outcom = xios_comm
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
+        END IF
+        
+        !Enregistrement des variables globales:
+        g_comm = xios_comm
+        g_ctx_name = xios_ctx_name
+        
+        ! Si couple alors init fait dans cpl_init
+        IF (.not. PRESENT(type_ocean)) THEN
+            CALL wxios_context_init()
+        ENDIF
+
+    END SUBROUTINE wxios_init
+
+    SUBROUTINE wxios_context_init()
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        TYPE(xios_context) :: xios_ctx
+
+        !Initialisation du contexte:
+        CALL xios_context_initialize(g_ctx_name, g_comm)
+        CALL xios_get_handle(g_ctx_name, xios_ctx)    !RÃ©cupÃ©ration
+        CALL xios_set_current_context(xios_ctx)            !Activation
+        g_ctx = xios_ctx
+
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
+          WRITE(lunout,*) "     now call xios_solve_inheritance()"
+        ENDIF
+        !Une premiÃ¨re analyse des hÃ©ritages:
+        CALL xios_solve_inheritance()
+    END SUBROUTINE wxios_context_init
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine de paramÃ©trisation !!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+     !ParamÃ¨tres:
+     CHARACTER(len=*), INTENT(IN) :: calendrier
+     INTEGER, INTENT(IN) :: annee, mois, jour
+     REAL, INTENT(IN) :: pasdetemps, heure
+     
+     !Variables:
+     CHARACTER(len=80) :: abort_message
+     CHARACTER(len=19) :: date
+     INTEGER :: njour = 1
+     
+     !Variables pour xios:
+     TYPE(xios_time) :: mdtime
+     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
+     
+        mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
+
+        !RÃ©glage du calendrier:
+        SELECT CASE (calendrier)
+            CASE('earth_360d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
+            CASE('earth_365d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
+            CASE('earth_366d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
+            CASE DEFAULT
+                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
+                CALL abort_gcm('Gcm:Xios',abort_message,1)
+        END SELECT
+        
+        !Formatage de la date de dÃ©part:
+        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
+        
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
+        
+        CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
+        
+        !Et enfin,le pas de temps:
+        CALL xios_set_timestep(mdtime)
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
+    END SUBROUTINE wxios_set_cal
+
+    SUBROUTINE wxios_set_timestep(ts)
+        REAL, INTENT(IN) :: ts
+        TYPE(xios_time) :: mdtime     
+
+        mdtime = xios_time(0, 0, 0, 0, 0, ts)
+
+        CALL xios_set_timestep(mdtime)
+    END SUBROUTINE wxios_set_timestep
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo,        &
+                                    ibegin, iend, ii_begin, ii_end, jbegin, jend,       &
+                                    data_ni, data_ibegin, data_iend,                    &
+                                    io_lat, io_lon,is_south_pole,mpi_rank)
+         
+
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
+        LOGICAL,INTENT(IN) :: is_sequential ! flag
+        INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
+        INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
+        INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
+        INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
+        INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain 
+        INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
+        INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
+        INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
+        INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain 
+        INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
+        INTEGER,INTENT(IN) :: data_ni
+        INTEGER,INTENT(IN) :: data_ibegin
+        INTEGER,INTENT(IN) :: data_iend
+        REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
+        REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
+        logical,intent(in) :: is_south_pole ! does this process include the south pole?
+        integer,intent(in) :: mpi_rank ! rank of process
+        
+        TYPE(xios_domain) :: dom
+        LOGICAL :: boool
+        
+        !Masque pour les problÃ¨mes de recouvrement MPI:
+        LOGICAL :: mask(ni,nj)
+        
+        !On rÃ©cupÃ¨re le handle:
+        CALL xios_get_domain_handle(dom_id, dom)
+        
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
+        ENDIF
+        
+        !On parametrise le domaine:
+        CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin, ni=ni)
+        CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin, nj=nj, data_dim=2)
+        CALL xios_set_domain_attr_hdl(dom, lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
+
+        IF (.NOT.is_sequential) THEN
+            mask(:,:)=.TRUE.
+            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
+            if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
+            ! special case for south pole
+            if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
+            ENDIF
+            CALL xios_set_domain_attr_hdl(dom, mask=mask)
+        END IF
+
+         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
+        !VÃ©rification:
+        IF (xios_is_valid_domain(dom_id)) THEN
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
+        ELSE
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
+        END IF
+    END SUBROUTINE wxios_domain_param
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un axe vertical !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        CHARACTER (len=*), INTENT(IN) :: axis_id
+        INTEGER, INTENT(IN) :: axis_size
+        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
+        
+!        TYPE(xios_axisgroup) :: axgroup
+!        TYPE(xios_axis) :: ax
+!        CHARACTER(len=50) :: axis_id 
+        
+!        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
+!          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
+!          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
+!          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
+!        ENDIF
+!        axis_id=trim(axisgroup_id)
+        
+        !On rÃ©cupÃ¨re le groupe d'axes qui va bien:
+        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
+        
+        !On ajoute l'axe correspondant Ã  ce fichier:
+        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
+        
+        !Et on le parametrise:
+        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
+        
+        ! Ehouarn: New way to declare axis, without axis_group:
+        CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value)
+        
+        !VÃ©rification:
+        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
+        ELSE
+            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
+        END IF
+
+    END SUBROUTINE wxios_add_vaxis
+    
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un fichier  !!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: ffreq
+        INTEGER, INTENT(IN) :: flvl
+        
+        TYPE(xios_file) :: x_file
+        TYPE(xios_filegroup) :: x_fg
+        CHARACTER(len=100) :: nffreq
+        
+        !On regarde si le fichier n'est pas dÃ©fini par XML:
+        IF (.NOT.xios_is_valid_file(fname)) THEN
+            !On crÃ©Ã© le noeud:
+            CALL xios_get_filegroup_handle("defile", x_fg)
+            CALL xios_add_file(x_fg, x_file, fname)
+        
+            !On reformate la frÃ©quence:
+            CALL reformadate(ffreq, nffreq)
+        
+            !On configure:
+            CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
+                output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
+        
+            IF (xios_is_valid_file("X"//fname)) THEN
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
+                  WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                ENDIF
+            ELSE
+                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
+                WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+            END IF
+        ELSE
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " dÃ©fined using XML."
+            ENDIF
+            ! Ehouarn: add an enable=.true. on top of xml definitions... why???
+            CALL xios_set_file_attr(fname, enabled=.TRUE.)
+        END IF
+    END SUBROUTINE wxios_add_file
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour crÃ©er un champ      !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
+        USE netcdf, only: nf90_fill_real
+
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+        
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        
+        TYPE(xios_field) :: field
+        CHARACTER(len=10) :: newunit
+        REAL(KIND=8) :: def
+        
+        !La valeur par dÃ©faut des champs non dÃ©finis:
+        def = nf90_fill_real
+        
+        IF (fieldunit .EQ. " ") THEN
+            newunit = "-"
+        ELSE
+            newunit = fieldunit
+        ENDIF
+        
+        !On ajoute le champ:
+        CALL xios_add_field(fieldgroup, field, fieldname)
+        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
+        
+        !On rentre ses paramÃ¨tres:
+        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
+
+    END SUBROUTINE wxios_add_field
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un champ      !!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        INTEGER, INTENT(IN)          :: fdim, fid
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        INTEGER, INTENT(IN)          :: field_level
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
+        CHARACTER(len=100) :: operation
+        TYPE(xios_file) :: f
+        TYPE(xios_field) :: field
+        TYPE(xios_fieldgroup) :: fieldgroup
+        LOGICAL :: bool=.FALSE.
+        INTEGER :: lvl =0
+        
+        
+        ! Ajout Abd pour NMC:
+        IF (fid.LE.6) THEN
+          axis_id="presnivs"
+        ELSE
+          axis_id="plev"
+        ENDIF
+        
+        !on prÃ©pare le nom de l'opÃ©ration:
+        operation = reformaop(op)
+        
+        
+        !On selectionne le bon groupe de champs:
+        IF (fdim.EQ.2) THEN
+          CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
+        ELSE
+          CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
+        ENDIF
+        
+        !On regarde si le champ Ã  dÃ©jÃ  Ã©tÃ© crÃ©Ã© ou non:
+        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
+            !Si ce champ existe via XML (ie, dÃ¨s le premier passage, ie g_field_name != fieldname) alors rien d'autre Ã  faire
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
+            g_flag_xml = .TRUE.
+            g_field_name = fieldname
+
+        ELSE IF (.NOT. g_field_name == fieldname) THEN
+            !Si premier pssage et champ indÃ©fini, alors on le crÃ©Ã©
+
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
+            
+            !On le crÃ©Ã©:
+            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
+            IF (xios_is_valid_field(fieldname)) THEN
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
+            ENDIF
+
+            g_flag_xml = .FALSE.
+            g_field_name = fieldname
+
+        END IF
+
+        IF (.NOT. g_flag_xml) THEN
+            !Champ existe dÃ©jÃ , mais pas XML, alors on l'ajoute
+            !On ajoute le champ:
+            CALL xios_get_file_handle(fname, f)
+            CALL xios_add_fieldtofile(f, field)
+            
+            
+            !L'operation, sa frequence:
+            CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
+
+            
+            !On rentre ses paramÃ¨tres:
+            CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
+            
+            IF (fdim.EQ.2) THEN
+                !Si c'est un champ 2D:
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                ENDIF
+            ELSE
+                !Si 3D :
+                !On ajoute l'axe vertical qui va bien:
+                CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
+                
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
+                ENDIF
+            END IF
+        
+        ELSE
+            !Sinon on se contente de l'activer:
+            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
+            !NB: This will override an enable=.false. set by a user in the xml file;
+            !   then the only way to not output the field is by changing its
+            !   output level
+        ENDIF       
+        
+    END SUBROUTINE wxios_add_field_to_file
+    
+!    SUBROUTINE wxios_update_calendar(ito)
+!        INTEGER, INTENT(IN) :: ito
+!        CALL xios_update_calendar(ito)
+!    END SUBROUTINE wxios_update_calendar
+!    
+!    SUBROUTINE wxios_write_2D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
+!
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_2D
+    
+!    SUBROUTINE wxios_write_3D(fieldname, fdata)
+!        CHARACTER(len=*), INTENT(IN) :: fieldname
+!        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
+!        
+!        CALL xios_send_field(fieldname, fdata)
+!    END SUBROUTINE wxios_write_3D
+    
+    SUBROUTINE wxios_closedef()
+        CALL xios_close_context_definition()
+        CALL xios_update_calendar(0)
+    END SUBROUTINE wxios_closedef
+    
+    SUBROUTINE wxios_close()
+        CALL xios_context_finalize()
+         CALL xios_finalize()
+     END SUBROUTINE wxios_close
+END MODULE wxios
+#endif
+
Index: /trunk/LMDZ.COMMON/libf/misc/xercnt.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xercnt.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xercnt.F	(revision 1403)
@@ -0,0 +1,62 @@
+*DECK XERCNT
+      SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  XERCNT
+C***SUBSIDIARY
+C***PURPOSE  Allow user control over handling of errors.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERCNT-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        Allows user control over handling of individual errors.
+C        Just after each message is recorded, but before it is
+C        processed any further (i.e., before it is printed or
+C        a decision to abort is made), a call is made to XERCNT.
+C        If the user has provided his own version of XERCNT, he
+C        can then override the value of KONTROL used in processing
+C        this message by redefining its value.
+C        KONTRL may be set to any value from -2 to 2.
+C        The meanings for KONTRL are the same as in XSETF, except
+C        that the value of KONTRL changes only for this message.
+C        If KONTRL is set to a value outside the range from -2 to 2,
+C        it will be moved back into that range.
+C
+C     Description of Parameters
+C
+C      --Input--
+C        LIBRAR - the library that the routine is in.
+C        SUBROU - the subroutine that XERMSG is being called from
+C        MESSG  - the first 20 characters of the error message.
+C        NERR   - same as in the call to XERMSG.
+C        LEVEL  - same as in the call to XERMSG.
+C        KONTRL - the current value of the control flag as set
+C                 by a call to XSETF.
+C
+C      --Output--
+C        KONTRL - the new value of KONTRL.  If KONTRL is not
+C                 defined, it will remain at its original value.
+C                 This changed value of control affects only
+C                 the current occurrence of the current message.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900206  Routine changed from user-callable to subsidiary.  (WRB)
+C   900510  Changed calling sequence to include LIBRARY and SUBROUTINE
+C           names, changed routine name from XERCTL to XERCNT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERCNT
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      INTEGER NERR, LEVEL, KONTRL
+C***FIRST EXECUTABLE STATEMENT  XERCNT
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/xerhlt.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xerhlt.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xerhlt.F	(revision 1403)
@@ -0,0 +1,39 @@
+*DECK XERHLT
+      SUBROUTINE XERHLT (MESSG)
+C***BEGIN PROLOGUE  XERHLT
+C***SUBSIDIARY
+C***PURPOSE  Abort program execution and print error message.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERHLT-A)
+C***KEYWORDS  ABORT PROGRAM EXECUTION, ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        ***Note*** machine dependent routine
+C        XERHLT aborts the execution of the program.
+C        The error message causing the abort is given in the calling
+C        sequence, in case one needs it for printing on a dayfile,
+C        for example.
+C
+C     Description of Parameters
+C        MESSG is as in XERMSG.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900206  Routine changed from user-callable to subsidiary.  (WRB)
+C   900510  Changed calling sequence to delete length of character
+C           and changed routine name from XERABT to XERHLT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERHLT
+      CHARACTER*(*) MESSG
+C***FIRST EXECUTABLE STATEMENT  XERHLT
+      STOP
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/xermsg.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xermsg.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xermsg.F	(revision 1403)
@@ -0,0 +1,368 @@
+*DECK XERMSG
+      SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  XERMSG
+C***PURPOSE  Process error messages for SLATEC and other libraries.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERMSG-A)
+C***KEYWORDS  ERROR MESSAGE, XERROR
+C***AUTHOR  Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C   XERMSG processes a diagnostic message in a manner determined by the
+C   value of LEVEL and the current value of the library error control
+C   flag, KONTRL.  See subroutine XSETF for details.
+C
+C    LIBRAR   A character constant (or character variable) with the name
+C             of the library.  This will be 'SLATEC' for the SLATEC
+C             Common Math Library.  The error handling package is
+C             general enough to be used by many libraries
+C             simultaneously, so it is desirable for the routine that
+C             detects and reports an error to identify the library name
+C             as well as the routine name.
+C
+C    SUBROU   A character constant (or character variable) with the name
+C             of the routine that detected the error.  Usually it is the
+C             name of the routine that is calling XERMSG.  There are
+C             some instances where a user callable library routine calls
+C             lower level subsidiary routines where the error is
+C             detected.  In such cases it may be more informative to
+C             supply the name of the routine the user called rather than
+C             the name of the subsidiary routine that detected the
+C             error.
+C
+C    MESSG    A character constant (or character variable) with the text
+C             of the error or warning message.  In the example below,
+C             the message is a character constant that contains a
+C             generic message.
+C
+C                   CALL XERMSG ('SLATEC', 'MMPY',
+C                  *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION',
+C                  *3, 1)
+C
+C             It is possible (and is sometimes desirable) to generate a
+C             specific message--e.g., one that contains actual numeric
+C             values.  Specific numeric values can be converted into
+C             character strings using formatted WRITE statements into
+C             character variables.  This is called standard Fortran
+C             internal file I/O and is exemplified in the first three
+C             lines of the following example.  You can also catenate
+C             substrings of characters to construct the error message.
+C             Here is an example showing the use of both writing to
+C             an internal file and catenating character strings.
+C
+C                   CHARACTER*5 CHARN, CHARL
+C                   WRITE (CHARN,10) N
+C                   WRITE (CHARL,10) LDA
+C                10 FORMAT(I5)
+C                   CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN//
+C                  *   ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'//
+C                  *   CHARL, 3, 1)
+C
+C             There are two subtleties worth mentioning.  One is that
+C             the // for character catenation is used to construct the
+C             error message so that no single character constant is
+C             continued to the next line.  This avoids confusion as to
+C             whether there are trailing blanks at the end of the line.
+C             The second is that by catenating the parts of the message
+C             as an actual argument rather than encoding the entire
+C             message into one large character variable, we avoid
+C             having to know how long the message will be in order to
+C             declare an adequate length for that large character
+C             variable.  XERMSG calls XERPRN to print the message using
+C             multiple lines if necessary.  If the message is very long,
+C             XERPRN will break it into pieces of 72 characters (as
+C             requested by XERMSG) for printing on multiple lines.
+C             Also, XERMSG asks XERPRN to prefix each line with ' *  '
+C             so that the total line length could be 76 characters.
+C             Note also that XERPRN scans the error message backwards
+C             to ignore trailing blanks.  Another feature is that
+C             the substring '$$' is treated as a new line sentinel
+C             by XERPRN.  If you want to construct a multiline
+C             message without having to count out multiples of 72
+C             characters, just use '$$' as a separator.  '$$'
+C             obviously must occur within 72 characters of the
+C             start of each line to have its intended effect since
+C             XERPRN is asked to wrap around at 72 characters in
+C             addition to looking for '$$'.
+C
+C    NERR     An integer value that is chosen by the library routine's
+C             author.  It must be in the range -99 to 999 (three
+C             printable digits).  Each distinct error should have its
+C             own error number.  These error numbers should be described
+C             in the machine readable documentation for the routine.
+C             The error numbers need be unique only within each routine,
+C             so it is reasonable for each routine to start enumerating
+C             errors from 1 and proceeding to the next integer.
+C
+C    LEVEL    An integer value in the range 0 to 2 that indicates the
+C             level (severity) of the error.  Their meanings are
+C
+C            -1  A warning message.  This is used if it is not clear
+C                that there really is an error, but the user's attention
+C                may be needed.  An attempt is made to only print this
+C                message once.
+C
+C             0  A warning message.  This is used if it is not clear
+C                that there really is an error, but the user's attention
+C                may be needed.
+C
+C             1  A recoverable error.  This is used even if the error is
+C                so serious that the routine cannot return any useful
+C                answer.  If the user has told the error package to
+C                return after recoverable errors, then XERMSG will
+C                return to the Library routine which can then return to
+C                the user's routine.  The user may also permit the error
+C                package to terminate the program upon encountering a
+C                recoverable error.
+C
+C             2  A fatal error.  XERMSG will not return to its caller
+C                after it receives a fatal error.  This level should
+C                hardly ever be used; it is much better to allow the
+C                user a chance to recover.  An example of one of the few
+C                cases in which it is permissible to declare a level 2
+C                error is a reverse communication Library routine that
+C                is likely to be called repeatedly until it integrates
+C                across some interval.  If there is a serious error in
+C                the input such that another step cannot be taken and
+C                the Library routine is called again without the input
+C                error having been corrected by the caller, the Library
+C                routine will probably be called forever with improper
+C                input.  In this case, it is reasonable to declare the
+C                error to be fatal.
+C
+C    Each of the arguments to XERMSG is input; none will be modified by
+C    XERMSG.  A routine may make multiple calls to XERMSG with warning
+C    level messages; however, after a call to XERMSG with a recoverable
+C    error, the routine should return to the user.  Do not try to call
+C    XERMSG with a second recoverable error after the first recoverable
+C    error because the error package saves the error number.  The user
+C    can retrieve this error number by calling another entry point in
+C    the error handling package and then clear the error number when
+C    recovering from the error.  Calling XERMSG in succession causes the
+C    old error number to be overwritten by the latest error number.
+C    This is considered harmless for error numbers associated with
+C    warning messages but must not be done for error numbers of serious
+C    errors.  After a call to XERMSG with a recoverable error, the user
+C    must be given a chance to call NUMXER or XERCLR to retrieve or
+C    clear the error number.
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE
+C***REVISION HISTORY  (YYMMDD)
+C   880101  DATE WRITTEN
+C   880621  REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988.
+C           THERE ARE TWO BASIC CHANGES.
+C           1.  A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO
+C               PRINT MESSAGES.  THIS ROUTINE WILL BREAK LONG MESSAGES
+C               INTO PIECES FOR PRINTING ON MULTIPLE LINES.  '$$' IS
+C               ACCEPTED AS A NEW LINE SENTINEL.  A PREFIX CAN BE
+C               ADDED TO EACH LINE TO BE PRINTED.  XERMSG USES EITHER
+C               ' ***' OR ' *  ' AND LONG MESSAGES ARE BROKEN EVERY
+C               72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE
+C               LENGTH OUTPUT CAN NOW BE AS GREAT AS 76.
+C           2.  THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE
+C               FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE
+C               OF LOWER CASE.
+C   880708  REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30.
+C           THE PRINCIPAL CHANGES ARE
+C           1.  CLARIFY COMMENTS IN THE PROLOGUES
+C           2.  RENAME XRPRNT TO XERPRN
+C           3.  REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES
+C               SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE /
+C               CHARACTER FOR NEW RECORDS.
+C   890706  REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C           CLEAN UP THE CODING.
+C   890721  REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN
+C           PREFIX.
+C   891013  REVISED TO CORRECT COMMENTS.
+C   891214  Prologue converted to Version 4.0 format.  (WRB)
+C   900510  Changed test on NERR to be -9999999 < NERR < 99999999, but
+C           NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3.  Added
+C           LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and
+C           XERCTL to XERCNT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERMSG
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      CHARACTER*8 XLIBR, XSUBR
+      CHARACTER*72  TEMP
+      CHARACTER*20  LFIRST
+      INTEGER NERR, LEVEL, LKNTRL
+      INTEGER J4SAVE, MAXMES, KDUMMY, I, KOUNT, LERR, LLEVEL
+      INTEGER MKNTRL, LTEMP
+C***FIRST EXECUTABLE STATEMENT  XERMSG
+      LKNTRL = J4SAVE (2, 0, .FALSE.)
+      MAXMES = J4SAVE (4, 0, .FALSE.)
+C
+C       LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL.
+C       MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE
+C          SHOULD BE PRINTED.
+C
+C       WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN
+C          CALLING XERMSG.  THE ERROR NUMBER SHOULD BE POSITIVE,
+C          AND THE LEVEL SHOULD BE BETWEEN 0 AND 2.
+C
+      IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR.
+     *   LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN
+         CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' //
+     *      'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '//
+     *      'JOB ABORT DUE TO FATAL ERROR.', 72)
+         CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY)
+         CALL XERHLT (' ***XERMSG -- INVALID INPUT')
+         RETURN
+      ENDIF
+C
+C       RECORD THE MESSAGE.
+C
+      I = J4SAVE (1, NERR, .TRUE.)
+      CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT)
+C
+C       HANDLE PRINT-ONCE WARNING MESSAGES.
+C
+      IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN
+C
+C       ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG.
+C
+      XLIBR  = LIBRAR
+      XSUBR  = SUBROU
+      LFIRST = MESSG
+      LERR   = NERR
+      LLEVEL = LEVEL
+      CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL)
+C
+      LKNTRL = MAX(-2, MIN(2,LKNTRL))
+      MKNTRL = ABS(LKNTRL)
+C
+C       SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS
+C       ZERO AND THE ERROR IS NOT FATAL.
+C
+      IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30
+      IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30
+      IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30
+      IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30
+C
+C       ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A
+C       MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS)
+C       AND SENDING IT OUT VIA XERPRN.  PRINT ONLY IF CONTROL FLAG
+C       IS NOT ZERO.
+C
+      IF (LKNTRL .NE. 0) THEN
+         TEMP(1:21) = 'MESSAGE FROM ROUTINE '
+         I = MIN(LEN(SUBROU), 16)
+         TEMP(22:21+I) = SUBROU(1:I)
+         TEMP(22+I:33+I) = ' IN LIBRARY '
+         LTEMP = 33 + I
+         I = MIN(LEN(LIBRAR), 16)
+         TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I)
+         TEMP(LTEMP+I+1:LTEMP+I+1) = '.'
+         LTEMP = LTEMP + I + 1
+         CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+      ENDIF
+C
+C       IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE
+C       PRINTING THE MESSAGE.  THE INTRODUCTORY LINE TELLS THE CHOICE
+C       FROM EACH OF THE FOLLOWING THREE OPTIONS.
+C       1.  LEVEL OF THE MESSAGE
+C              'INFORMATIVE MESSAGE'
+C              'POTENTIALLY RECOVERABLE ERROR'
+C              'FATAL ERROR'
+C       2.  WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE
+C              'PROG CONTINUES'
+C              'PROG ABORTED'
+C       3.  WHETHER OR NOT A TRACEBACK WAS REQUESTED.  (THE TRACEBACK
+C           MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS
+C           WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.)
+C              'TRACEBACK REQUESTED'
+C              'TRACEBACK NOT REQUESTED'
+C       NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT
+C       EXCEED 74 CHARACTERS.
+C       WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED.
+C
+      IF (LKNTRL .GT. 0) THEN
+C
+C       THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL.
+C
+         IF (LEVEL .LE. 0) THEN
+            TEMP(1:20) = 'INFORMATIVE MESSAGE,'
+            LTEMP = 20
+         ELSEIF (LEVEL .EQ. 1) THEN
+            TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,'
+            LTEMP = 30
+         ELSE
+            TEMP(1:12) = 'FATAL ERROR,'
+            LTEMP = 12
+         ENDIF
+C
+C       THEN WHETHER THE PROGRAM WILL CONTINUE.
+C
+         IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR.
+     *       (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN
+            TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,'
+            LTEMP = LTEMP + 14
+         ELSE
+            TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,'
+            LTEMP = LTEMP + 16
+         ENDIF
+C
+C       FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK.
+C
+         IF (LKNTRL .GT. 0) THEN
+            TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED'
+            LTEMP = LTEMP + 20
+         ELSE
+            TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED'
+            LTEMP = LTEMP + 24
+         ENDIF
+         CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+      ENDIF
+C
+C       NOW SEND OUT THE MESSAGE.
+C
+      CALL XERPRN (' *  ', -1, MESSG, 72)
+C
+C       IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A
+C          TRACEBACK.
+C
+      IF (LKNTRL .GT. 0) THEN
+         WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR
+         DO 10 I=16,22
+            IF (TEMP(I:I) .NE. ' ') GO TO 20
+   10    CONTINUE
+C
+   20    CALL XERPRN (' *  ', -1, TEMP(1:15) // TEMP(I:23), 72)
+         CALL FDUMP
+      ENDIF
+C
+C       IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE.
+C
+      IF (LKNTRL .NE. 0) THEN
+         CALL XERPRN (' *  ', -1, ' ', 72)
+         CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72)
+         CALL XERPRN ('    ',  0, ' ', 72)
+      ENDIF
+C
+C       IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE
+C       CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN.
+C
+   30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN
+C
+C       THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A
+C       FATAL ERROR.  PRINT THE REASON FOR THE ABORT AND THE ERROR
+C       SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT.
+C
+      IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN
+         IF (LEVEL .EQ. 1) THEN
+            CALL XERPRN
+     *         (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72)
+         ELSE
+            CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72)
+         ENDIF
+         CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY)
+         CALL XERHLT (' ')
+      ELSE
+         CALL XERHLT (MESSG)
+      ENDIF
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/xerprn.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xerprn.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xerprn.F	(revision 1403)
@@ -0,0 +1,231 @@
+*DECK XERPRN
+      SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  XERPRN
+C***SUBSIDIARY
+C***PURPOSE  Print error messages processed by XERMSG.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERPRN-A)
+C***KEYWORDS  ERROR MESSAGES, PRINTING, XERROR
+C***AUTHOR  Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C This routine sends one or more lines to each of the (up to five)
+C logical units to which error messages are to be sent.  This routine
+C is called several times by XERMSG, sometimes with a single line to
+C print and sometimes with a (potentially very long) message that may
+C wrap around into multiple lines.
+C
+C PREFIX  Input argument of type CHARACTER.  This argument contains
+C         characters to be put at the beginning of each line before
+C         the body of the message.  No more than 16 characters of
+C         PREFIX will be used.
+C
+C NPREF   Input argument of type INTEGER.  This argument is the number
+C         of characters to use from PREFIX.  If it is negative, the
+C         intrinsic function LEN is used to determine its length.  If
+C         it is zero, PREFIX is not used.  If it exceeds 16 or if
+C         LEN(PREFIX) exceeds 16, only the first 16 characters will be
+C         used.  If NPREF is positive and the length of PREFIX is less
+C         than NPREF, a copy of PREFIX extended with blanks to length
+C         NPREF will be used.
+C
+C MESSG   Input argument of type CHARACTER.  This is the text of a
+C         message to be printed.  If it is a long message, it will be
+C         broken into pieces for printing on multiple lines.  Each line
+C         will start with the appropriate prefix and be followed by a
+C         piece of the message.  NWRAP is the number of characters per
+C         piece; that is, after each NWRAP characters, we break and
+C         start a new line.  In addition the characters '$$' embedded
+C         in MESSG are a sentinel for a new line.  The counting of
+C         characters up to NWRAP starts over for each new line.  The
+C         value of NWRAP typically used by XERMSG is 72 since many
+C         older error messages in the SLATEC Library are laid out to
+C         rely on wrap-around every 72 characters.
+C
+C NWRAP   Input argument of type INTEGER.  This gives the maximum size
+C         piece into which to break MESSG for printing on multiple
+C         lines.  An embedded '$$' ends a line, and the count restarts
+C         at the following character.  If a line break does not occur
+C         on a blank (it would split a word) that word is moved to the
+C         next line.  Values of NWRAP less than 16 will be treated as
+C         16.  Values of NWRAP greater than 132 will be treated as 132.
+C         The actual line length will be NPREF + NWRAP after NPREF has
+C         been adjusted to fall between 0 and 16 and NWRAP has been
+C         adjusted to fall between 16 and 132.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  I1MACH, XGETUA
+C***REVISION HISTORY  (YYMMDD)
+C   880621  DATE WRITTEN
+C   880708  REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF
+C           JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK
+C           THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE
+C           SLASH CHARACTER IN FORMAT STATEMENTS.
+C   890706  REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C           STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK
+C           LINES TO BE PRINTED.
+C   890721  REVISED TO ADD A NEW FEATURE.  A NEGATIVE VALUE OF NPREF
+C           CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.
+C   891013  REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.
+C   891214  Prologue converted to Version 4.0 format.  (WRB)
+C   900510  Added code to break messages between words.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERPRN
+      CHARACTER*(*) PREFIX, MESSG
+      INTEGER NPREF, NWRAP
+      CHARACTER*148 CBUFF
+      INTEGER IU(5), NUNIT
+      CHARACTER*2 NEWLIN
+      PARAMETER (NEWLIN = '$$')
+      INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC
+      INTEGER LPIECE, IDELTA
+C***FIRST EXECUTABLE STATEMENT  XERPRN
+      CALL XGETUA(IU,NUNIT)
+C
+C       A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD
+C       ERROR MESSAGE UNIT INSTEAD.  I1MACH(4) RETRIEVES THE STANDARD
+C       ERROR MESSAGE UNIT.
+C
+      N = I1MACH(4)
+      DO 10 I=1,NUNIT
+         IF (IU(I) .EQ. 0) IU(I) = N
+   10 CONTINUE
+C
+C       LPREF IS THE LENGTH OF THE PREFIX.  THE PREFIX IS PLACED AT THE
+C       BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING
+C       THE REST OF THIS ROUTINE.
+C
+      IF ( NPREF .LT. 0 ) THEN
+         LPREF = LEN(PREFIX)
+      ELSE
+         LPREF = NPREF
+      ENDIF
+      LPREF = MIN(16, LPREF)
+      IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX
+C
+C       LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE
+C       TIME FROM MESSG TO PRINT ON ONE LINE.
+C
+      LWRAP = MAX(16, MIN(132, NWRAP))
+C
+C       SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.
+C
+      LENMSG = LEN(MESSG)
+      N = LENMSG
+      DO 20 I=1,N
+         IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30
+         LENMSG = LENMSG - 1
+   20 CONTINUE
+   30 CONTINUE
+C
+C       IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.
+C
+      IF (LENMSG .EQ. 0) THEN
+         CBUFF(LPREF+1:LPREF+1) = ' '
+         DO 40 I=1,NUNIT
+            WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)
+   40    CONTINUE
+         RETURN
+      ENDIF
+C
+C       SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING
+C       STARTS.  FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.
+C       WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.
+C       WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.
+C
+C       WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL.  THE
+C       INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE
+C       OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH
+C       OF THE SECOND ARGUMENT.
+C
+C       THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE
+C       FOLLOWING ORDER.  WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER
+C       OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT
+C       POSITION NEXTC.
+C
+C       LPIECE .EQ. 0   THE NEW LINE SENTINEL DOES NOT OCCUR IN THE
+C                       REMAINDER OF THE CHARACTER STRING.  LPIECE
+C                       SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,
+C                       WHICHEVER IS LESS.
+C
+C       LPIECE .EQ. 1   THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:
+C                       NEXTC).  LPIECE IS EFFECTIVELY ZERO, AND WE
+C                       PRINT NOTHING TO AVOID PRODUCING UNNECESSARY
+C                       BLANK LINES.  THIS TAKES CARE OF THE SITUATION
+C                       WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF
+C                       EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE
+C                       SENTINEL FOLLOWED BY MORE CHARACTERS.  NEXTC
+C                       SHOULD BE INCREMENTED BY 2.
+C
+C       LPIECE .GT. LWRAP+1  REDUCE LPIECE TO LWRAP.
+C
+C       ELSE            THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1
+C                       RESET LPIECE = LPIECE-1.  NOTE THAT THIS
+C                       PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.
+C                       LWRAP+1.  THAT IS, THE SENTINEL FALLS EXACTLY
+C                       AT THE END OF A LINE.
+C
+      NEXTC = 1
+   50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN)
+      IF (LPIECE .EQ. 0) THEN
+C
+C       THERE WAS NO NEW LINE SENTINEL FOUND.
+C
+         IDELTA = 0
+         LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)
+         IF (LPIECE .LT. LENMSG+1-NEXTC) THEN
+            DO 52 I=LPIECE+1,2,-1
+               IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+                  LPIECE = I-1
+                  IDELTA = 1
+                  GOTO 54
+               ENDIF
+   52       CONTINUE
+         ENDIF
+   54    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC = NEXTC + LPIECE + IDELTA
+      ELSEIF (LPIECE .EQ. 1) THEN
+C
+C       WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).
+C       DON'T PRINT A BLANK LINE.
+C
+         NEXTC = NEXTC + 2
+         GO TO 50
+      ELSEIF (LPIECE .GT. LWRAP+1) THEN
+C
+C       LPIECE SHOULD BE SET DOWN TO LWRAP.
+C
+         IDELTA = 0
+         LPIECE = LWRAP
+         DO 56 I=LPIECE+1,2,-1
+            IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+               LPIECE = I-1
+               IDELTA = 1
+               GOTO 58
+            ENDIF
+   56    CONTINUE
+   58    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC = NEXTC + LPIECE + IDELTA
+      ELSE
+C
+C       IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.
+C       WE SHOULD DECREMENT LPIECE BY ONE.
+C
+         LPIECE = LPIECE - 1
+         CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC  = NEXTC + LPIECE + 2
+      ENDIF
+C
+C       PRINT
+C
+      DO 60 I=1,NUNIT
+         WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)
+   60 CONTINUE
+C
+      IF (NEXTC .LE. LENMSG) GO TO 50
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/xersve.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xersve.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xersve.F	(revision 1403)
@@ -0,0 +1,159 @@
+*DECK XERSVE
+      SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
+     +   ICOUNT)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  XERSVE
+C***SUBSIDIARY
+C***PURPOSE  Record that an error has occurred.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3
+C***TYPE      ALL (XERSVE-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C *Usage:
+C
+C        INTEGER  KFLAG, NERR, LEVEL, ICOUNT
+C        CHARACTER * (len) LIBRAR, SUBROU, MESSG
+C
+C        CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
+C
+C *Arguments:
+C
+C        LIBRAR :IN    is the library that the message is from.
+C        SUBROU :IN    is the subroutine that the message is from.
+C        MESSG  :IN    is the message to be saved.
+C        KFLAG  :IN    indicates the action to be performed.
+C                      when KFLAG > 0, the message in MESSG is saved.
+C                      when KFLAG=0 the tables will be dumped and
+C                      cleared.
+C                      when KFLAG < 0, the tables will be dumped and
+C                      not cleared.
+C        NERR   :IN    is the error number.
+C        LEVEL  :IN    is the error severity.
+C        ICOUNT :OUT   the number of times this message has been seen,
+C                      or zero if the table has overflowed and does not
+C                      contain this message specifically.  When KFLAG=0,
+C                      ICOUNT will not be altered.
+C
+C *Description:
+C
+C   Record that this error occurred and possibly dump and clear the
+C   tables.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  I1MACH, XGETUA
+C***REVISION HISTORY  (YYMMDD)
+C   800319  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900413  Routine modified to remove reference to KFLAG.  (WRB)
+C   900510  Changed to add LIBRARY NAME and SUBROUTINE to calling
+C           sequence, use IF-THEN-ELSE, make number of saved entries
+C           easily changeable, changed routine name from XERSAV to
+C           XERSVE.  (RWC)
+C   910626  Added LIBTAB and SUBTAB to SAVE statement.  (BKS)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERSVE
+      INTEGER,PARAMETER :: LENTAB=10
+      INTEGER LUN(5)
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      CHARACTER*8  LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB
+      CHARACTER*20 MESTAB(LENTAB), MES
+      DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB)
+      SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
+      DATA KOUNTX/0/, NMSG/0/
+      INTEGER NERR,LEVEL,KONTRL
+      INTEGER NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
+      INTEGER KFLAG, ICOUNT, NUNIT, KUNIT, IUNIT, I1MACH, I
+C***FIRST EXECUTABLE STATEMENT  XERSVE
+C
+      IF (KFLAG.LE.0) THEN
+C
+C        Dump the table.
+C
+         IF (NMSG.EQ.0) RETURN
+C
+C        Print to each unit.
+C
+         CALL XGETUA (LUN, NUNIT)
+         DO 20 KUNIT = 1,NUNIT
+            IUNIT = LUN(KUNIT)
+            IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
+C
+C           Print the table header.
+C
+            WRITE (IUNIT,9000)
+C
+C           Print body of table.
+C
+            DO 10 I = 1,NMSG
+               WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
+     *            NERTAB(I),LEVTAB(I),KOUNT(I)
+   10       CONTINUE
+C
+C           Print number of other errors.
+C
+            IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX
+            WRITE (IUNIT,9030)
+   20    CONTINUE
+C
+C        Clear the error tables.
+C
+         IF (KFLAG.EQ.0) THEN
+            NMSG = 0
+            KOUNTX = 0
+         ENDIF
+      ELSE
+C
+C        PROCESS A MESSAGE...
+C        SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
+C        OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
+C
+         LIB = LIBRAR
+         SUB = SUBROU
+         MES = MESSG
+         DO 30 I = 1,NMSG
+            IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.
+     *         MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND.
+     *         LEVEL.EQ.LEVTAB(I)) THEN
+                  KOUNT(I) = KOUNT(I) + 1
+                  ICOUNT = KOUNT(I)
+                  RETURN
+            ENDIF
+   30    CONTINUE
+C
+         IF (NMSG.LT.LENTAB) THEN
+C
+C           Empty slot found for new message.
+C
+            NMSG = NMSG + 1
+            LIBTAB(I) = LIB
+            SUBTAB(I) = SUB
+            MESTAB(I) = MES
+            NERTAB(I) = NERR
+            LEVTAB(I) = LEVEL
+            KOUNT (I) = 1
+            ICOUNT    = 1
+         ELSE
+C
+C           Table is full.
+C
+            KOUNTX = KOUNTX+1
+            ICOUNT = 0
+         ENDIF
+      ENDIF
+      RETURN
+C
+C     Formats.
+C
+ 9000 FORMAT ('0          ERROR MESSAGE SUMMARY' /
+     +   ' LIBRARY    SUBROUTINE MESSAGE START             NERR',
+     +   '     LEVEL     COUNT')
+ 9010 FORMAT (1X,A,3X,A,3X,A,3I10)
+ 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10)
+ 9030 FORMAT (1X)
+      END
Index: /trunk/LMDZ.COMMON/libf/misc/xgetua.F
===================================================================
--- /trunk/LMDZ.COMMON/libf/misc/xgetua.F	(revision 1403)
+++ /trunk/LMDZ.COMMON/libf/misc/xgetua.F	(revision 1403)
@@ -0,0 +1,53 @@
+*DECK XGETUA
+      SUBROUTINE XGETUA (IUNITA, N)
+      IMPLICIT NONE
+C***BEGIN PROLOGUE  XGETUA
+C***PURPOSE  Return unit number(s) to which error messages are being
+C            sent.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XGETUA-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        XGETUA may be called to determine the unit number or numbers
+C        to which error messages are being sent.
+C        These unit numbers may have been set by a call to XSETUN,
+C        or a call to XSETUA, or may be a default value.
+C
+C     Description of Parameters
+C      --Output--
+C        IUNIT - an array of one to five unit numbers, depending
+C                on the value of N.  A value of zero refers to the
+C                default unit, as defined by the I1MACH machine
+C                constant routine.  Only IUNIT(1),...,IUNIT(N) are
+C                defined by XGETUA.  The values of IUNIT(N+1),...,
+C                IUNIT(5) are not defined (for N .LT. 5) or altered
+C                in any way by XGETUA.
+C        N     - the number of units to which copies of the
+C                error messages are being sent.  N will be in the
+C                range from 1 to 5.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  J4SAVE
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XGETUA
+      DIMENSION IUNITA(5)
+      INTEGER IUNITA, N, J4SAVE, INDEX, I
+C***FIRST EXECUTABLE STATEMENT  XGETUA
+      N = J4SAVE(5,0,.FALSE.)
+      DO 30 I=1,N
+         INDEX = I+4
+         IF (I.EQ.1) INDEX = 3
+         IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
+   30 CONTINUE
+      RETURN
+      END
Index: /trunk/LMDZ.COMMON/makelmdz
===================================================================
--- /trunk/LMDZ.COMMON/makelmdz	(revision 1402)
+++ /trunk/LMDZ.COMMON/makelmdz	(revision 1403)
@@ -79,5 +79,5 @@
 
 CPP_KEY="" 
-INCLUDE='-I$(LIBF)/grid -I$(LIBF)/bibio -I$(LIBF)/filtrez -I. '
+INCLUDE='-I$(LIBF)/grid -I$(LIBF)/misc -I$(LIBF)/filtrez -I. '
 LIB=""
 adjnt=""
@@ -86,4 +86,6 @@
 PARA_LD=""
 EXT_SRC=""
+#src_dirs: directories containing source files 
+src_dirs="grid misc" 
 ccompiler=""
 OPTIMC=""
@@ -116,4 +118,6 @@
 [-chimie INCA/false]       : (Earth) with INCA chemistry model or without (default: false)
 [-cosp cosp/false]         : (Earth) add the cosp model (default: false)
+[-sisvat true/false]  : (Earth) compile with/without sisvat package (default: false)
+[-rrtm true/false]    : (Earth) compile with/without rrtm package (default: false)
 [-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
 [-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
@@ -292,13 +296,25 @@
 for inc in $archfileline ; do INCLUDE="$INCLUDE `echo $inc | grep '\-I'`" ; done
 
+phys_root=$physique
+if [[ "${physique:0:3}" == "lmd" ]] ; then phys_root=lmd ; fi
+if [[ "${physique:0:3}" == "mar" ]] ; then phys_root=mar ; fi
+if [[ "${physique:0:4}" == "mars" ]] ; then phys_root=mars ; fi
+if [[ "${physique:0:3}" == "std" ]] ; then phys_root=std ; fi
+if [[ "${physique:0:5}" == "venus" ]] ; then phys_root=venus ; fi
+if [[ "${physique:0:5}" == "titan" ]] ; then phys_root=titan ; fi
+if [[ "${physique:0:3}" == "dev" ]] ; then phys_root=dev ; fi
+
 if [[ "$physique" != "nophys" ]]
 then
+   #We'll use some physics
+   src_dirs="$src_dirs phy$physique"
+   LIBPHY='$(LIBO)/libphy'"$physique"'.a'
+   lib_phy='-lphy'"$physique"
    CPP_KEY="$CPP_KEY CPP_PHYS"
-fi
-
-if [[ "$physique" == "lmd" ]]
-then
-   #Default planet type is Earth
+   if [[ "${phys_root}" == "lmd" ]]
+   then
+   #For lmd physics, default planet type is Earth
    CPP_KEY="$CPP_KEY CPP_EARTH"
+   fi
 fi
 
@@ -309,4 +325,5 @@
    LIB="$LIB -l${LIBPREFIX}chim$physique"
    opt_dep="$opt_dep chim$physique"
+   src_dirs="$src_dirs chim$physique"
 # get C compiler name and optim from arch.fcm file
    archfileline=$( grep -i '^%C_COMPILER' arch.fcm )
@@ -322,4 +339,5 @@
 if [[ -d ${LIBFGCM}/aerono${physique} ]]
 then
+   src_dirs="$src_dirs aerono$physique"
    INCLUDE="$INCLUDE -I${LIBFGCM}/aerono${physique}"
    LIB="$LIB -l${LIBPREFIX}aerono$physique"
@@ -442,4 +460,5 @@
    CPP_KEY="$CPP_KEY CPP_COSP"
    COSP_PATH="$LIBFGCM/cosp"
+   src_dirs="$src_dirs cosp"
 #   LIB="${LIB} -l${LIBPREFIX}cosp"
    opt_dep="$opt_dep cosp"
@@ -451,4 +470,5 @@
 then
    CPP_KEY="$CPP_KEY CPP_SISVAT"
+   src_dirs="$src_dirs phy${physique}/sisvat"
 fi
 
@@ -456,4 +476,5 @@
 then
    CPP_KEY="$CPP_KEY CPP_RRTM"
+   src_dirs="$src_dirs phy${physique}/rrtm"
 fi
 
@@ -507,4 +528,9 @@
 cd $LIBFGCM/grid/dimension
 ./makdim $dim
+if (($? != 0))
+then
+    exit 1
+fi
+
 cat $LIBFGCM/grid/dimensions.h
 cd $LMDGCM
@@ -534,8 +560,13 @@
 ########################################################################
 
-dimension=`echo $dim | wc -w`
-echo dimension $dimension
-
-if (( $dimension == 3 )) ; then
+if (( $dimc == 3 )) ; then
+   src_dirs="$src_dirs $filtre dyn3d_common dyn3d${FLAG_PARA}"
+   if [[ $physique != "nophys" ]] ; then
+     src_dirs="$src_dirs dynlonlat_phylonlat dynlonlat_phylonlat/phy${phys_root}"
+     libdyn_phy="-ldynlonlat_phylonlat"
+     LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
+     INCLUDE="$INCLUDE "'-I$(LIBF)/dynlonlat_phylonlat'
+     INCLUDE="$INCLUDE "'-I$(LIBF)/dynlonlat_phylonlat/'"${phys_root}"
+   fi
   cd $LIBFGCM/grid
   \rm fxyprim.h
@@ -543,12 +574,15 @@
   filtre="FILTRE=$filtre"
   INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d${FLAG_PARA} -I$(LIBF)/dyn3d_common '
-elif (( $dimension == 2 )) ; then
+elif (( $dimc == 2 )) ; then
+   src_dirs="$src_dirs dyn2d"
    filtre="FILTRE= L_FILTRE= "
    INCLUDE="$INCLUDE "'-I$(LIBF)/dyn2d'
-elif (( $dimension == 1 )) ; then
+elif (( $dimc == 1 )) ; then
    echo pas de dynamique
+   src_dirs="$src_dirs phy${physique}/dyn1d"
    CPP_KEY="$CPP_KEY CPP_1D"
-   filtre="L_DYN= DYN= FILTRE= L_FILTRE= DIRMAIN=phy$physique "
-   INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d -I$(LIBF)/dyn3d_common ' # Pas tres propre
+   filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+   #INCLUDE="$INCLUDE "'-I$(LIBF)/dyn3d -I$(LIBF)/dyn3d_common ' # Pas tres propre
+   INCLUDE="$INCLUDE "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 else
    echo Dimension dimc=$dimc pas prevu ; exit
@@ -588,7 +622,28 @@
 ########################################################################
 cd $LMDGCM
-find libf -name '*.[Fh]' -print | sort > tmp77
-find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print | sort > tmp90
-find libf -name '*.F90' -print | sort >> tmp90
+
+
+if [[ -r .makelmdz ]]
+then
+old_lmdz_configuration=$(cat .makelmdz )
+else
+old_lmdz_configuration=""
+fi
+lmdz_configuration="$src_dirs"
+if [[ "$lmdz_configuration" != "$old_lmdz_configuration" ]]
+then
+  configuration_change="true"
+else
+  configuration_change="false"
+fi
+
+mkdir -p make_dir
+suf_make=`echo $src_dirs | sed -e 's/\//_/g' -e 's/ /_/g'`
+echo suf_make $suf_make
+
+\rm tmp77 tmp90
+for dir in $src_dirs ; do
+find libf/$dir -name '*.[Fh]' -print | sort >> tmp77
+find libf/$dir -name '*.F90' -print | sort >> tmp90
 ######### CAS PARTICULIER CHIMIE TITAN
 if [[ "$physique" == "titan" ]]
@@ -597,34 +652,43 @@
 fi
 #########
-
-if [[ ! ( -r makefile ) || ! ( -r liste_des_sources_f90 ) || ! ( -r liste_des_sources_f77 ) || ` diff tmp77 liste_des_sources_f77 | wc -w ` -ne 0 || ` diff tmp90 liste_des_sources_f90 | wc -w ` -ne 0 ]]
+done
+
+liste77=make_dir/liste_des_sources_f77_$suf_make
+liste90=make_dir/liste_des_sources_f90_$suf_make
+if [[ "$physique" == "titan" ]] ; then
+listeC=make_dir/liste_des_sources_C_$suf_make
+fi
+makefile=make_dir/makefile_$suf_make
+
+if [[ $configuration_change == "true" || ! ( -r makefile ) || ! ( -r $liste_90 ) || ! ( -r $liste_77 ) || ` diff tmp77 $liste_77 | wc -w ` -ne 0 || ` diff tmp90 $liste_90 | wc -w ` -ne 0 ]]
 then
   echo "les fichiers suivants ont ete crees ou detruits"
   echo "ou les fichiers suivants sont passes ou ne sont plus en Fortran 90"
-  diff liste_des_sources_f77 tmp77
-  diff liste_des_sources_f90 tmp90
-  \cp -f tmp77 liste_des_sources_f77
-  \cp -f tmp90 liste_des_sources_f90
+  diff $liste77  tmp77
+  diff $liste90 tmp90
+  \cp -f tmp77 $liste77
+  \cp -f tmp90 $liste90
 ######### CAS PARTICULIER CHIMIE TITAN
   if [[ "$physique" == "titan" ]]
   then 
-  diff liste_des_sources_C tmpC
-  \cp -f tmpC liste_des_sources_C
+  diff $listeC tmpC
+  \cp -f tmpC $listeC
   fi
 #########
-  echo "on recree le makefile"
-  ./create_make_gcm > tmp 
-  \mv -f tmp makefile
-  echo "Nouveau makefile cree"
+  echo "Recreating the makefile"
+  echo "src_dirs: $src_dirs"
+  ./create_make_gcm $src_dirs > tmp 
+  \mv -f tmp $makefile
+  echo "New makefile created"
 ######### CAS PARTICULIER CHIMIE TITAN
 else if [[ "$physique" == "titan" ]]
  then
-   if [[ ! ( -r liste_des_sources_C ) || ` diff tmpC liste_des_sources_C | wc -w ` -ne 0 ]]
+   if [[ ! ( -r $listeC ) || ` diff tmpC $listeC | wc -w ` -ne 0 ]]
    then
-     diff liste_des_sources_C tmpC
-     \cp -f tmpC liste_des_sources_C
+     diff $listeC tmpC
+     \cp -f tmpC $listeC
      echo "on recree le makefile"
-     ./create_make_gcm > tmp 
-     \mv -f tmp makefile
+     ./create_make_gcm $src_dirs > tmp 
+     \mv -f tmp $makefile
      echo "Nouveau makefile cree"
    fi
@@ -633,4 +697,9 @@
 fi
 
+ln -sf $makefile makefile
+
+#Create a .makelmdz file containing main compilation option for later comparisons
+echo "$lmdz_configuration" > .makelmdz
+
 #################################################################
 # Preparation de l'execution de la commande make
@@ -641,25 +710,36 @@
 then
   source_code=${code}.F
-  code_dir=dyn${dimc}d${FLAG_PARA}
+  dirmain=dyn${dimc}d${FLAG_PARA}
 else
   if [[ -r $LMDGCM/libf/dyn${dimc}d${FLAG_PARA}/${code}.F90 ]]
   then
     source_code=${code}.F90
-    code_dir=dyn${dimc}d${FLAG_PARA}
+    dirmain=dyn${dimc}d${FLAG_PARA}
   else
     if [[ -r $LMDGCM/libf/phy${physique}/${code}.F ]]
     then
       source_code=${code}.F
-      code_dir=phy${physique}
+      dirmain=phy${physique}
     else
-      # last possibility:
       if [[ -r $LMDGCM/libf/phy${physique}/${code}.F90 ]]
       then
         source_code=${code}.F90
-        code_dir=phy${physique}
+        dirmain=phy${physique}
       else
-        echo "Error: cannot find ${code}.F[90]"
-        echo " neither in dyn${dimc}d${FLAG_PARA} nor in phy${physique}"
-        exit
+        if [[ -r $LMDGCM/libf/dynlonlat_phylonlat/phy$phys_root/${code}.F ]] 
+        then
+          source_code=${code}.F
+          dirmain="dynlonlat_phylonlat/phy${phys_root}"
+        else
+          if [[ -r $LMDGCM/libf/phy$physique/dyn1d/${code}.F ]]
+          then
+            source_code=${code}.F
+            dirmain=phy$physique/dyn1d
+          else
+            echo "Error: cannot find ${code}.F[90]"
+            echo " neither in dyn${dimc}d${FLAG_PARA} nor in phy${physique}"
+            exit
+          fi
+        fi
       fi
     fi
@@ -684,15 +764,16 @@
 then
   INCLUDE="$INCLUDE"' -I$(LIBF)/phy'"$physique"
-  phys="PHYS=$physique"
-else
-  # trick to avoid having a physics-related library in the makefile
-  phys="L_PHY= LIBPHY="
-fi
-if (( $dimension == 1 ))
-then
- INCLUDE="$INCLUDE"' -I$(LIBF)/dyn3d -I'${LIBOGCM}/${nomlib}
-else
- INCLUDE="$INCLUDE"' -I$(LIBF)/dyn'${dimc}'d'$FLAG_PARA' -I'${LIBOGCM}/${nomlib}
-fi
+#  phys="PHYS=$physique"
+#else
+#  # trick to avoid having a physics-related library in the makefile
+#  phys="L_PHY= LIBPHY="
+fi
+INCLUDE="$INCLUDE"' -I'${LIBOGCM}/${nomlib}
+#if (( $dimension == 1 ))
+#then
+# INCLUDE="$INCLUDE"' -I$(LIBF)/dyn3d -I'${LIBOGCM}/${nomlib}
+#else
+#INCLUDE="$INCLUDE"' -I$(LIBF)/dyn'${dimc}'d'$FLAG_PARA' -I'${LIBOGCM}/${nomlib}
+#fi
 
 # ranlib utility (check it exists or else default to ls)
@@ -727,7 +808,11 @@
 $filtre \
 LIBO=${LIBOGCM}/${nomlib} \
-$phys \
+"PHYS=$physique" \
+LIBPHY=${LIBPHY} \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 FLAG_PARA=$FLAG_PARA \
+L_PHY="$lib_phy" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT=$adjnt \
 L_COSP="$lcosp" \
@@ -744,5 +829,5 @@
 MOD_SUFFIX="mod" \
 AR=$arcommand \
-DIRMAIN=$code_dir \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -758,7 +843,11 @@
 $filtre \
 LIBO=${LIBOGCM}/${nomlib} \
-$phys \
+"PHYS=$physique" \
+LIBPHY=${LIBPHY} \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 FLAG_PARA=$FLAG_PARA \
+L_PHY="$lib_phy" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 L_COSP="$lcosp" \
@@ -775,5 +864,5 @@
 MOD_SUFFIX="mod" \
 AR=$arcommand \
-DIRMAIN=$code_dir \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
Index: /trunk/LMDZ.COMMON/makelmdz_fcm
===================================================================
--- /trunk/LMDZ.COMMON/makelmdz_fcm	(revision 1402)
+++ /trunk/LMDZ.COMMON/makelmdz_fcm	(revision 1403)
@@ -40,5 +40,9 @@
 LIBOGCM=$LMDGCM/libo
 LIBFGCM=$LMDGCM/libf
+DYN_COMMON_PATH=$LIBFGCM/dyn3d_common
 # path for optional packages, but default set to ".void_dir"
+FILTRE_PATH=$LMDGCM/.void_dir
+DYN_PHYS_PATH=$LMDGCM/.void_dir
+DYN_PHYS_SUB_PATH=$LMDGCM/.void_dir
 RRTM_PATH=$LMDGCM/.void_dir
 SISVAT_PATH=$LMDGCM/.void_dir
@@ -87,4 +91,6 @@
 [-chimie INCA/false]       : (Earth) with INCA chemistry model or without (default: false)
 [-cosp cosp/false]         : (Earth) add the cosp model (default: false)
+[-sisvat true/false]  : (Earth) compile with/without sisvat package (default: false)
+[-rrtm true/false]    : (Earth) compile with/without rrtm package (default: false)
 [-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
 [-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
@@ -236,13 +242,30 @@
 fi
 
+phys_root=$physique
+if [[ "${physique:0:3}" == "lmd" ]] ; then phys_root=lmd ; fi
+if [[ "${physique:0:3}" == "mar" ]] ; then phys_root=mar ; fi
+if [[ "${physique:0:4}" == "mars" ]] ; then phys_root=mars ; fi
+if [[ "${physique:0:3}" == "std" ]] ; then phys_root=std ; fi
+if [[ "${physique:0:5}" == "venus" ]] ; then phys_root=venus ; fi
+if [[ "${physique:0:5}" == "titan" ]] ; then phys_root=titan ; fi
+if [[ "${physique:0:3}" == "dev" ]] ; then phys_root=dev ; fi
+
 if [[ "$physique" != "nophys" ]]
 then
    #We'll use some physics
    CPP_KEY="$CPP_KEY CPP_PHYS"
-   if [[ "${physique:0:3}" == "lmd" ]]
+   if [[ "${phys_root}" == "lmd" ]]
    then
    #For lmd physics, default planet type is Earth
    CPP_KEY="$CPP_KEY CPP_EARTH"
    fi
+   # set the dyn/phys interface path
+   DYN_PHYS_PATH="${LIBFGCM}/dynlonlat_phylonlat"
+   DYN_PHYS_SUB_PATH="${LIBFGCM}/dynlonlat_phylonlat/phy${phys_root}"
+fi
+
+if [[ "$filtre" == "filtrez" ]]
+then
+   FILTRE_PATH=${LIBFGCM}/$filtre
 fi
 
@@ -360,5 +383,6 @@
 fi
 
-if [[ "$physique" == "titan" ]]
+# for Titan (but could be used by others as well), there is also "chimtitan"
+if [[ -d ${LIBFGCM}/chim${physique} ]]
 then
    CHEM_PATH="${LIBFGCM}/chim${physique}"
@@ -463,8 +487,15 @@
 if (( $dimension == 1 ))
 then
+  CPP_KEY="$CPP_KEY CPP_1D"
 ##in 1D, add dyn3d to include path (because main prog is in physics)
-  INCLUDE="$INCLUDE -Ilibf/dyn3d"
-#  echo pas de dynamique
-#  dyn="DYN= L_DYN=-ldyn3d "
+  INCLUDE="$INCLUDE -Ilibf/dyn3d -Ilibf/dyn3d_common"
+## no filtre in 1d:
+  FILTRE_PATH=$LMDGCM/.void_dir
+## no need to compile all routines in dyn3d_common either:
+  DYN_COMMON_PATH=$LMDGCM/.void_dir
+## no need to compile all routines in dynlmdz_phy... ;
+## (because key ones are included in 1D main program)
+  DYN_PHYS_PATH=$LMDGCM/.void_dir
+  DYN_PHYS_SUB_PATH=$LMDGCM/.void_dir
 fi
 
@@ -523,9 +554,10 @@
 else
   SUFF_NAME=${SUFF_NAME}_seq
-  DYN=dyn${dimc}d
-  ## specific stuff for 1D model (needs includes which are in dyn3d)
-  if (( $dimension == 1 )) ; then
-    SUFF_NAME=${SUFF_NAME}
-    DYN=dyn3d
+  if (( $dimension == 1 ))
+  then
+    # dynamics-related routines in"dyn1d" subdirectory of phy${physique} 
+    DYN=phy${physique}/dyn1d
+  else
+    DYN=dyn${dimc}d
   fi
 fi
@@ -561,5 +593,9 @@
 echo "%LIBO          $LIBOGCM"       >> $config_fcm
 echo "%DYN           $DYN"           >> $config_fcm
+echo "%DYN_COMMON    $DYN_COMMON_PATH" >> $config_fcm
+echo "%FILTRE        $FILTRE_PATH"   >> $config_fcm
 echo "%PHYS          phy${physique}" >> $config_fcm
+echo "%DYN_PHYS      $DYN_PHYS_PATH" >> $config_fcm
+echo "%DYN_PHYS_SUB  $DYN_PHYS_SUB_PATH" >> $config_fcm
 echo "%RRTM          $RRTM_PATH"     >> $config_fcm
 echo "%SISVAT        $SISVAT_PATH"   >> $config_fcm
@@ -594,12 +630,4 @@
 ln -s $LIBOGCM/${arch}${SUFF_NAME}/.config/tmp tmp_src
 
-#eventual cleanup for SISVAT
-#sed -e 's/^src::sisvat/#src::sisvat/' bld.cfg > bld.tmp
-#mv bld.tmp bld.cfg
-
-#eventual cleanup for RRTM
-#sed -e 's/^src::rrtm/#src::rrtm/' bld.cfg > bld.tmp
-#mv bld.tmp bld.cfg
-
 
 if [[ -r $LIBFGCM/grid/dimensions.h ]]
Index: /trunk/LMDZ.GENERIC/README
===================================================================
--- /trunk/LMDZ.GENERIC/README	(revision 1402)
+++ /trunk/LMDZ.GENERIC/README	(revision 1403)
@@ -1054,2 +1054,17 @@
 == 04/03/2015 == EM
 - Some code cleanup: turning comcstfi.h into module comcstfi_mod
+
+== 31/03/2015 == EM
+- Reorganizing the physics/dynamics interface, for better compatibility
+  between models and with the parallel LMDZ.COMMON dyn core. Main structural
+  changes are:
+* misc: (replaces what was the "bibio" directory)
+- Should only contain extremely generic (and non physics or
+  dynamics-specific) routines
+* dynlonlat_phylonlat: (new interface directory)
+- This directory contains routines relevent to physics/dynamics grid
+  interactions, e.g. routines gr_dyn_fi or gr_fi_dyn and calfis
+- Moreover the dynlonlat_phylonlat contains directory "phystd".
+  This subdirectories should only contain specific interfaces (e.g. 
+  iniphysiq) or main programs (e.g. newstart).
+* phystd/dyn1d: this subdirectory contains the 1D models.
Index: /trunk/LMDZ.GENERIC/create_make_gcm
===================================================================
--- /trunk/LMDZ.GENERIC/create_make_gcm	(revision 1402)
+++ /trunk/LMDZ.GENERIC/create_make_gcm	(revision 1403)
@@ -11,7 +11,13 @@
 #          ., dyn3d and grid
 #
+
+# arguments given to create_make_gcm are the directories to scan
+src_dirs=$*
+
 machine=`hostname`
 os=`uname`
 gcm=`pwd`
+logfile=$gcm/create_make_gcm.log
+rm -f $logfile ; touch -f $logfile
 libf=$gcm/libf
 libo=$gcm/libo
@@ -51,10 +57,11 @@
 #echo $localdir
 echo "LOCAL_DIR=`echo $localdir`"
-echo 'BIBIO    = $(LIBF)/bibio'
-##echo 'AERONOMARS    = $(LIBF)/aeronomars'
+echo 'MISC    = $(LIBF)/misc'
+#echo 'AERONOMARS    = $(LIBF)/aeronomars'
 echo "FILTRE   = filtre"
 echo "PHYS  = "
 echo 'DYN  = $(DYNTYPE)'
 echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'LIBDYN_PHY = $(LIBO)/libdynlmdz_phy$(PHYS).a'
 echo 'DIRMAIN= $(DYN)$(DIM)d'
 echo 'RM=rm'
@@ -64,25 +71,11 @@
 echo '# Les differentes librairies pour l"edition des liens:'
 echo
-if [ "$XNEC" = '1' ] ; then
-  echo 'dyn3d      = $(LIBO)/libsxdyn3d.a $(LIBO)/libsx$(FILTRE).a'
-  echo 'dyn2d      = $(LIBO)/libsxdyn2d.a'
-  echo 'dyn1d      = $(LIBO)/libsxdyn1d.a'
-  echo 'L_DYN      = -lsxdyn$(DIM)d'
-  echo 'L_FILTRE   = -lsx$(FILTRE)'
-  echo 'L_PHY = -lsxphy$(PHYS) '
-  echo 'L_BIBIO    = -lsxbibio'
-##  echo 'L_AERONOMARS    = -lsxaeronomars'
-  echo 'L_ADJNT    ='
-else
-  echo 'dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
-  echo 'dyn2d      = $(LIBO)/libdyn2d.a'
-  echo 'dyn1d      = $(LIBO)/libdyn1d.a'
-  echo 'L_DYN      = -l$(DYN)$(DIM)d'
-  echo 'L_FILTRE   = -l$(FILTRE)'
-  echo 'L_PHY = -lphy$(PHYS) '
-  echo 'L_BIBIO    = -lbibio'
-##  echo 'L_AERONOMARS    = -laeronomars'
-  echo 'L_ADJNT    ='
-fi
+echo 'L_DYN      = -ldyn$(DIM)d'
+echo 'L_FILTRE   = -l$(FILTRE)'
+echo 'L_DYN_PHY = -ldynlmdz_phy$(PHYS) '
+echo 'L_PHY = -lphy$(PHYS) '
+echo 'L_MISC    = -lmisc'
+#echo 'L_AERONOMARS    = -laeronomars'
+echo 'L_ADJNT    ='
 echo
 echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
@@ -105,16 +98,14 @@
 echo
 echo "PROG = code"
-echo
-##echo 'main : $(DYN) bibio phys aeronomars $(OPTION_DEP) '
-echo 'main : $(DYN) bibio phys $(OPTION_DEP) '
+echo 'DYN  = dyn$(DIM)d'
+echo
+echo 'main : $(DYN) misc phys dyn_phy $(OPTION_DEP) '
 echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '	cd $(LOCAL_DIR); \'
 echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
 if [ "$CRAY" = '0' ] ; then
-##echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_PHY) $(L_BIBIO) $(L_DYN) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_DYN_PHY) $(L_ADJNT) $(L_FILTRE) $(L_PHY) $(L_DYN_PHY) $(L_MISC) $(L_DYN) $(L_PHY) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 else
-##echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_PHY) $(L_BIBIO) $(L_DYN) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_DYN_PHY) $(L_ADJNT) $(L_FILTRE) $(L_PHY) $(L_DYN_PHY) $(L_MISC) $(L_DYN) $(L_PHY) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 fi
 echo
@@ -125,8 +116,14 @@
 echo 'phys : $(LIBPHY)'
 echo
-echo 'bibio : $(LIBO)/libbibio.a'
-echo
-##echo 'aeronomars : $(LIBO)/libaeronomars.a'
-##echo
+echo 'dyn3d : $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+echo 'dyn2d : $(LIBO)/libdyn2d.a'
+echo 'dyn1d : '
+echo
+echo 'dyn_phy: $(LIBDYN_PHYS)'
+echo
+echo 'misc : $(LIBO)/libmisc.a'
+echo
+#echo 'aeronomars : $(LIBO)/libaeronomars.a'
+#echo
 echo 'adjnt : $(LIBO)/libadjnt.a'
 echo
@@ -143,122 +140,121 @@
 echo
 cd $libf >/dev/null 2>&1
-for diri in ` ls `
-do
+
+for diri in $src_dirs ; do
+
    if [ -d $diri ] ; then
-   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.F90`" != "" ]  ; then 
-      cd $diri >/dev/null 2>&1
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.[fF]90`" != "" ]  ; then 
+#      cd $diri >/dev/null 2>&1
       echo
       listlib=""
-      for i in `ls *.F`
-      do
-         fili=`basename $i .F`
+# Liste des fichiers .F et .F90 n'etant pas des programmes principaux
+      for fili in `ls $diri/*.[fF]` ; do
          # Check if file is a routine or main program
          # i.e: look for the "program" keword preceeded by leading spaces
-         test=` (  head $i | grep -i '^ *program' ) `
-         if [ "$test" = "" ] ; then 
-            # if it is not a main program, add it to the list
-            listlib=$listlib" "$fili
-         fi
-      done
-      for i in `ls *.F90`
-      do
-         fili=`basename $i .F90`
+         test=` (  head $fili | grep -i '^ *program' ) `
+         # if it is not a main program, add it to the list
+         if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi
+      done
+      for fili in `ls $diri/*.[fF]90` ; do
          # Check if file is a routine or main program
          # i.e. look for "program" keyword (with possibly some leading spaces)
-         test=` (  head $i | grep -i '^ \{0,\}program' ) `
-         if [ "$test" = "" ] ; then
-            # if it is not a main program, add it to the list
-            listlib=$listlib" "$fili
-         fi 
-      done
-#
-      echo
-      echo
-      echo "#======================================================================="
+         test=` (  head $fili | grep -i '^ \{0,\}program' ) `
+         # if it is not a main program, add it to the list
+         if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi 
+      done
+      echo
+      echo $listlib >> $logfile
+      echo
+      # topdiri contains main dir name (without trailing "/blabla" for subdirs)
+      topdiri=${diri%/*}
+      echo "#=================================================================="
       echo "# Contenu de la bibliotheque correspondant au Directory "$diri
-      echo "#======================================================================="
-      echo
-      for fili in $listlib
-      do
-         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+      echo "#=================================================================="
+      echo
+      for trufile in $listlib ; do
+         fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1`
+         echo '$(LIBO)/lib'$topdiri".a : " '$(LIBO)/lib'$topdiri".a("$fili".o)"
          echo
       done
-      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
-      echo
-      echo
-      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
-      echo
-      for fili in $listlib
-      do
-         if [ -f $fili.F90 ] ; then
-           trufile=$fili.F90
-         else
-           trufile=$fili.F
-         fi
+      echo '.PRECIOUS	: $(LIBO)/lib'$topdiri'.a'
+      echo
+      echo
+      echo "# Compilation of elements in $diri of library lib"$topdiri".a"
+      echo
+      for trufile in $listlib ; do
+         fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1`
          F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1
                  egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
                  egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1
-         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile
-         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
-         for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | sed -e 's/,/ /' | awk ' { print $2 } ' ) `
-         do
-            stri=`echo $stri | tr [A-Z] [a-z]`
-            if [ -f $stri ] ; then
+         str1='$(LIBO)/lib'$topdiri'.a('$fili'.o) : $(LIBF)/'$trufile
+         [ "$fili" = "$diri/chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+
+##########################################################################
+# TRAITEMENT DES DEPENDANCES
+# Differents cas de dependance correspondant a des include ou des
+# use module.
+# soit dans le repertoire local soit dans un autre.
+# Pour dyn3d, il faudrait remplacer la chaine de caractere par $DYN
+# ou quelque chose du genre.
+##########################################################################
+
+         for stri in ` ( sed -e '/^[cC\!]/d' $trufile | sed -e "/\#include /s/\#include /XXnclude /" -e "/include /s/include /XXnclude /" -e "/INCLUDE /s/INCLUDE /XXnclude /" | sed -n "/XXnclude /s/XXnclude//p" | sed 's/\"//g' | sort | uniq ; sed -e '/^[cC\!]/d' $trufile | egrep -i '^ *use ' | sed -e 's/,/ /' | awk ' { print $2 } ' | sort | uniq ) ` ; do
+            echo $trufile $fili $stri >> $logfile
+            strj=`echo $stri | tr [A-Z] [a-z]`
+            str2=""
+            for dirinc in $src_dirs ; do
+# Recherche dans l'ordre hierarchique inverse car seule la derniere
+# ligne est conservee
+#               if [ $dirinc = phydev ] ; then
+#                   dirstr='$(PHYS)'
+#                   libstr='phy$(PHYS)'
+#               else
+                   dirstr=$dirinc
+                   libstr=$dirinc
+#               fi
+               echo dirinc $dirinc >> $logfile
+               if [ -f $dirinc/$stri ] ; then
+                  str2='$(LIBF)/'$dirstr/$stri
+               elif [ -f $dirinc/$strj ] ; then
+                  str2='$(LIBF)/'$dirstr/$stri
+               elif [ -f $dirinc/$strj.[fF]90 ]  || [ -f $dirinc/$strj.[fF] ]  ; then 
+                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
+                  str2='$(LIBO)/lib'$strlib'.a('$strj'.o)'
+               elif [ -f $dirinc/$stri.[fF]90 ]  || [ -f $dirinc/$stri.[fF] ]  ; then 
+                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
+                  str2='$(LIBO)/lib'$strlib'.a('$stri'.o)'
+               fi
+               echo stri $stri  >> $logfile
+               echo str2 $str2  >> $logfile
+            done
+               echo dernier str2 $str2  >> $logfile
+            if [ "$str2" = "" ] ; then
+               echo Warn: Include $diri $trufile $fili $stri pas trouve >> $logfile
+            elif [ "$str2" = "$str1" ] ; then
+               echo Warn: Include $diri $trufile $fili $stri $str1 trouve 2x >> $logfile
+            else
                echo $str1 \\
-               str1='$(LIBF)/'$diri'/'$stri
-            else
-               if [ -f $stri.F ] || [ -f $stri.F90 ] ; then
-                  echo $str1 \\
-                  str1='$(LIBO)/lib'$diri'.a('$stri'.o)'
-               else
-#                  for dirinc in dyn3d grid bibio aeronomars phymars
-                  for dirinc in $*
-                  do
-                     if [ -f ../$dirinc/$stri ] ; then
-                        echo $str1 \\
-                        str1='$(LIBF)/'`cd .. ; ls */$stri | head -1`
-                     fi
-                     if [ -f ../$dirinc/$stri.F90 ] ; then
-                        echo $str1 \\
-                        str1='$(LIBO)/lib'$dirinc'.a('$stri'.o)'
-                     fi
-                  done
-               fi
+               str1=$str2
             fi
-         done
+         done # Fin de la boucle sur les dependances et ecriture de la derniere
          echo $str1
-         # Compile in LOCAL_DIR directory, and before compiling,
-         # remove the object from the library
-         echo '	cd $(LOCAL_DIR); \'
-         echo '	$(AR) d $(LIBO)/lib'$diri'.a '$fili'.o ; \'
+         # Compile in LIBO directory; and before compiling, remove
+         # object from library
+         echo '	cd $(LIBO); \'
+         echo '	$(AR) d $(LIBO)/lib'$topdiri'.a '$fili'.o ; \'
 	 if [ "$F90" -eq '0' ] ; then
-	 ## Fixed Form Fortran 77
-           echo '	$(COMPILE) $(LIBF)/'$diri'/'$trufile' ; \'
+         ## Fixed Form Fortran 77
+	   echo '	$(COMPILE) $(LIBF)/'$trufile' ; \'
 	 else
          ## Fortran 90
-           if [ -f $fili.F90 ] ; then
-	   ## Free Form Fortran 90
-              echo '	$(COMPTRU90) $(LIBF)/'$diri'/'$trufile' ; \'
+           if [ `echo $trufile | cut -d. -f2` = F90 ] ; then
+	      ## Free Form
+              echo '	$(COMPTRU90) $(LIBF)/'$trufile' ; \'
            else
-	   ## Fixed Form Fortran 90
-              echo '	$(COMPILE90) $(LIBF)/'$diri'/'$trufile' ; \'
+	      echo '	$(COMPILE90) $(LIBF)/'$trufile' ; \'
            fi
-           ## If a module, handle created module descriptor file
-           MODU=0; egrep -i '^ *module ' $trufile> /dev/null 2>&1 && MODU=1
-            if [ "$MODU" -eq '1' -a "$CRAY" != '1' ] ; then
-              if [ "$os" = 'UNIX_System_V' ] ; then
-                echo '	cp $(MOD_LOC_DIR)/*.$(MOD_SUFFIX) $(LIBO)/ ; \'
-              else
-                echo '	mv $(MOD_LOC_DIR)/'$fili'.$(MOD_SUFFIX) $(LIBO)/'$fili'.$(MOD_SUFFIX) ; \'
-#                echo '	if [ "$(MOD_LOC_DIR)" ne "$(LIBO)" ] ; then mv $(MOD_LOC_DIR)/'*'.$(MOD_SUFFIX) $(LIBO) ; fi ; \'
-              fi
-            fi
 	 fi
-	 if ( [ "$XNEC" -eq '1' ] || [ "$X6NEC" = '1' ] || [ "$X8BRODIE" = '1' ] ) ; then
-           echo '	sxar r $(LIBO)/libsx'$diri'.a '$fili'.o ; \'
-         fi
          # Put generated object in library
-         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
-         echo '	cd $(GCM)'
+         echo '	$(AR) r $(LIBO)/lib'$topdiri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
 	 echo
       done
Index: unk/LMDZ.GENERIC/libf/dyn3d/calfis.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/calfis.F	(revision 1402)
+++ 	(revision )
@@ -1,558 +1,0 @@
-      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
-     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
-     $            pducov,pdvcov,pdteta,pdq,pw,
-     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
-c
-c    Auteur :  P. Le Van, F. Hourdin 
-c   .........
-      USE infotrac, ONLY: tname, nqtot
-      IMPLICIT NONE
-c=======================================================================
-c
-c   1. rearrangement des tableaux et transformation
-c      variables dynamiques  >  variables physiques
-c   2. calcul des termes physiques
-c   3. retransformation des tendances physiques en tendances dynamiques
-c
-c   remarques:
-c   ----------
-c
-c    - les vents sont donnes dans la physique par leurs composantes 
-c      naturelles.
-c    - la variable thermodynamique de la physique est une variable
-c      intensive :   T 
-c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
-c    - les deux seules variables dependant de la geometrie necessaires
-c      pour la physique sont la latitude pour le rayonnement et 
-c      l'aire de la maille quand on veut integrer une grandeur 
-c      horizontalement.
-c    - les points de la physique sont les points scalaires de la 
-c      la dynamique; numerotation:
-c          1 pour le pole nord
-c          (jjm-1)*iim pour l'interieur du domaine
-c          ngridmx pour le pole sud
-c      ---> ngridmx=2+(jjm-1)*iim
-c
-c     Input :
-c     -------
-c       ecritphy        frequence d'ecriture (en jours)de histphy
-c       pucov           covariant zonal velocity
-c       pvcov           covariant meridional velocity 
-c       pteta           potential temperature
-c       pps             surface pressure
-c       pmasse          masse d'air dans chaque maille
-c       pts             surface temperature  (K)
-c       pw              flux vertical (kg/s)
-c
-c    Output :
-c    --------
-c        pdufi          tendency for the natural zonal velocity (ms-1)
-c        pdvfi          tendency for the natural meridional velocity 
-c        pdhfi          tendency for the potential temperature
-c        pdtsfi         tendency for the surface temperature
-c
-c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-
-      INTEGER ngridmx,nq
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-!#include "control.h"
-
-!#include "advtrac.h"
-!! this is to get tnom (tracers name)
-
-c    Arguments :
-c    -----------
-      LOGICAL  lafin
-      REAL heure
-
-      REAL pvcov(iip1,jjm,llm)
-      REAL pucov(iip1,jjp1,llm)
-      REAL pteta(iip1,jjp1,llm)
-      REAL pmasse(iip1,jjp1,llm)
-      REAL pq(iip1,jjp1,llm,nqtot)
-      REAL pphis(iip1,jjp1)
-      REAL pphi(iip1,jjp1,llm)
-c
-      REAL pdvcov(iip1,jjm,llm)
-      REAL pducov(iip1,jjp1,llm)
-      REAL pdteta(iip1,jjp1,llm)
-      REAL pdq(iip1,jjp1,llm,nqtot)
-c
-      REAL pw(iip1,jjp1,llm)
-c
-      REAL pps(iip1,jjp1)
-      REAL pp(iip1,jjp1,llmp1)
-      REAL ppk(iip1,jjp1,llm)
-c
-      REAL pdvfi(iip1,jjm,llm)
-      REAL pdufi(iip1,jjp1,llm)
-      REAL pdhfi(iip1,jjp1,llm)
-      REAL pdqfi(iip1,jjp1,llm,nqtot)
-      REAL pdpsfi(iip1,jjp1)
-      logical tracer
-
-c    Local variables :
-c    -----------------
-
-      INTEGER i,j,l,ig0,ig,iq
-      REAL zpsrf(ngridmx)
-      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
-      REAL zphi(ngridmx,llm),zphis(ngridmx)
-c
-      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
-      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
-c
-      REAL zvervel(ngridmx,llm)
-c
-      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
-      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
-      REAL zdpsrf(ngridmx)
-c
-      REAL zsin(iim),zcos(iim),z1(iim)
-      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
-      REAL unskap, pksurcp
-c
-      
-      EXTERNAL gr_dyn_fi,gr_fi_dyn
-      EXTERNAL physiq,multipl
-      REAL SSUM
-      EXTERNAL SSUM
-
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-
-      LOGICAL firstcal, debut
-      DATA firstcal/.true./
-      SAVE firstcal,debut
-      REAL rdayvrai,rday_ecri
-c
-c-----------------------------------------------------------------------
-c
-c    1. Initialisations :
-c    --------------------
-c
-
-
-      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         PRINT*,'STOP dans calfis'
-         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         PRINT*,'  ngridmx  jjm   iim   '
-         PRINT*,ngridmx,jjm,iim
-         STOP
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   latitude, longitude et aires des mailles pour la physique:
-c   ----------------------------------------------------------
-
-c
-      IF ( firstcal )  THEN
-          debut = .TRUE.
-      ELSE
-          debut = .FALSE.
-      ENDIF
-
-c
-!      IF (firstcal) THEN
-!         latfi(1)=rlatu(1)
-!         lonfi(1)=0.
-!         DO j=2,jjm
-!            DO i=1,iim
-!               latfi((j-2)*iim+1+i)= rlatu(j)
-!               lonfi((j-2)*iim+1+i)= rlonv(i)
-!            ENDDO
-!         ENDDO
-!         latfi(ngridmx)= rlatu(jjp1)
-!         lonfi(ngridmx)= 0.
-!
-!         ! build airefi(), mesh area on physics grid
-!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-!         ! Poles are single points on physics grid
-!         airefi(1)=airefi(1)*iim
-!         airefi(ngridmx)=airefi(ngridmx)*iim
-!
-!         CALL inifis(ngridmx,llm,day_ini,daysec,dtphys,
-!     .                latfi,lonfi,airefi,rad,g,r,cpp)
-!      ENDIF
-
-c
-c-----------------------------------------------------------------------
-c   40. transformation des variables dynamiques en variables physiques:
-c   ---------------------------------------------------------------
-
-c   41. pressions au sol (en Pascals)
-c   ----------------------------------
-
-       
-      zpsrf(1) = pps(1,1)
-
-      ig0  = 2
-      DO j = 2,jjm
-         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
-         ig0 = ig0+iim
-      ENDDO
-
-      zpsrf(ngridmx) = pps(1,jjp1)
-
-
-c   42. pression intercouches :
-c
-c   -----------------------------------------------------------------
-c     .... zplev  definis aux (llm +1) interfaces des couches  ....
-c     .... zplay  definis aux (  llm )    milieux des couches  .... 
-c   -----------------------------------------------------------------
-
-c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
-c
-       unskap   = 1./ kappa
-c
-      DO l = 1, llmp1
-        zplev( 1,l ) = pp(1,1,l)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              zplev( ig0,l ) = pp(i,j,l)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        zplev( ngridmx,l ) = pp(1,jjp1,l)
-      ENDDO
-c
-c
-
-c   43. temperature naturelle (en K) et pressions milieux couches .
-c   ---------------------------------------------------------------
-
-      DO l=1,llm
-
-         pksurcp     =  ppk(1,1,l) / cpp
-         zplay(1,l)  =  preff * pksurcp ** unskap
-         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
-         ig0         =  2
-
-         DO j = 2, jjm
-            DO i = 1, iim
-              pksurcp        = ppk(i,j,l) / cpp
-              zplay(ig0,l)   = preff * pksurcp ** unskap
-              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
-              ig0            = ig0 + 1
-            ENDDO
-         ENDDO
-
-         pksurcp       = ppk(1,jjp1,l) / cpp
-         zplay(ig0,l)  = preff * pksurcp ** unskap
-         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
-
-      ENDDO
-
-      DO l=1, llm
-        DO ig=1,ngridmx
-             if (ztfi(ig,l).lt.15) then
-                  write(*,*) 'New Temperature below 15 K !!! '
-	              write(*,*) 'Stop in calfis.F '
-	              write(*,*) 'ig=', ig, ' l=', l
-                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
-                  stop
-             end if
-        ENDDO
-      ENDDO
-
-
-
-c   43.bis Taceurs (en kg/kg)
-c   --------------------------
-      DO iq=1,nqtot
-         DO l=1,llm
-            zqfi(1,l,iq) = pq(1,1,l,iq)
-            ig0          = 2
-            DO j=2,jjm
-               DO i = 1, iim
-                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
-                  ig0             = ig0 + 1
-               ENDDO
-            ENDDO
-            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
-         ENDDO
-      ENDDO
-
-c   Geopotentiel calcule par rapport a la surface locale:
-c   -----------------------------------------------------
-
-      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
-      DO l=1,llm
-         DO ig=1,ngridmx
-            zphi(ig,l)=zphi(ig,l)-zphis(ig)
-         ENDDO
-      ENDDO
-
-c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
-c   -------------------------------
-c     pw est en kg/s
-c On interpole "lineairement" la temperature entre les couches(FF,10/95)
-
-!      DO ig=1,ngridmx
-!         zvervel(ig,1)=0.
-!      END DO
-!      DO l=2,llm
-!        zvervel(1,l)=(pw(1,1,l)/apoln)
-!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
-!        ig0=2
-!       DO j=2,jjm
-!           DO i = 1, iim
-!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
-!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!              ig0 = ig0 + 1
-!           ENDDO
-!       ENDDO
-!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
-!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!      ENDDO
-
-c    .........  Reindexation : calcul de zvervel au MILIEU des couches
-!       DO l=1,llm-1
-!	      DO ig=1,ngridmx
-!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
-!          END DO 
-!       END DO 
-c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
-
-c   45. champ u:
-c   ------------
-
-      DO 50 l=1,llm
-
-         DO 25 j=2,jjm
-            ig0 = 1+(j-2)*iim
-            zufi(ig0+1,l)= 0.5 * 
-     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
-            DO 10 i=2,iim
-               zufi(ig0+i,l)= 0.5 *
-     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
-10         CONTINUE
-25      CONTINUE
-
-50    CONTINUE
-
-
-c   46.champ v:
-c   -----------
-
-      DO l=1,llm
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               zvfi(ig0+i,l)= 0.5 *
-     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
-            ENDDO
-         ENDDO
-      ENDDO
-
-
-c   47. champs de vents aux pole nord   
-c   ------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
-         ENDDO
-
-         DO i=1,iim
-            zcos(i)   = COS(rlonv(i))*z1(i)
-            zcosbis(i)= COS(rlonv(i))*z1bis(i)
-            zsin(i)   = SIN(rlonv(i))*z1(i)
-            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
-         ENDDO
-
-         zufi(1,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-
-c   48. champs de vents aux pole sud:
-c   ---------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
-      ENDDO
-
-         DO i=1,iim
-            zcos(i)    = COS(rlonv(i))*z1(i)
-            zcosbis(i) = COS(rlonv(i))*z1bis(i)
-            zsin(i)    = SIN(rlonv(i))*z1(i)
-            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
-      ENDDO
-
-         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   Appel de la physique:
-c   ---------------------
-
-
-      CALL physiq (ngridmx,llm,nq,
-     .     tname,
-     ,     debut,lafin,
-     ,     rday_ecri,heure,dtphys,
-     ,     zplev,zplay,zphi,
-     ,     zufi, zvfi,ztfi, zqfi,  
-!     ,     zvervel,
-     ,     pw,
-C - sorties
-     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
-
-
-c-----------------------------------------------------------------------
-c   transformation des tendances physiques en tendances dynamiques:
-c   ---------------------------------------------------------------
-
-c  tendance sur la pression :
-c  -----------------------------------
-
-      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
-c
-ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
-
-c   62. enthalpie potentielle
-c   ---------------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
-          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
-            ENDDO
-               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   62. traceurs
-c   ---------------------
-
-      DO iq=1,nqtot
-         DO l=1,llm
-            DO i=1,iip1
-               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
-               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
-            ENDDO
-            DO j=2,jjm
-               ig0=1+(j-2)*iim
-               DO i=1,iim
-                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
-               ENDDO
-               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
-            ENDDO
-         ENDDO
-      ENDDO
-
-c   65. champ u:
-c   ------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-            pdufi(i,1,l)    = 0.
-            pdufi(i,jjp1,l) = 0.
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim-1
-               pdufi(i,j,l)=
-     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
-            ENDDO
-            pdufi(iim,j,l)=
-     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
-            pdufi(iip1,j,l)=pdufi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   67. champ v:
-c   ------------
-
-      DO l=1,llm
-
-         DO j=2,jjm-1
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdvfi(i,j,l)=
-     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
-            ENDDO
-            pdvfi(iip1,j,l) = pdvfi(1,j,l)
-         ENDDO
-      ENDDO
-
-
-c   68. champ v pres des poles:
-c   ---------------------------
-c      v = U * cos(long) + V * SIN(long)
-
-      DO l=1,llm
-
-         DO i=1,iim
-            pdvfi(i,1,l)=
-     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
-            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
-     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
-            pdvfi(i,1,l)=
-     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
-            pdvfi(i,jjm,l)=
-     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
-          ENDDO
-
-         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
-         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-
-700   CONTINUE
-
-      firstcal = .FALSE.
-
-      RETURN
-      END
Index: /trunk/LMDZ.GENERIC/libf/dyn3d/gcm.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/gcm.F	(revision 1402)
+++ /trunk/LMDZ.GENERIC/libf/dyn3d/gcm.F	(revision 1403)
@@ -6,4 +6,5 @@
      &                       iconser, ecritphy, idissip
 !      use comgeomphy, only: initcomgeomphy
+      use filtreg_mod, only: inifilr
       IMPLICIT NONE
 
@@ -106,5 +107,5 @@
 
       EXTERNAL caldyn, traceur
-      EXTERNAL dissip,geopot,iniconst,inifilr
+      EXTERNAL dissip,geopot,iniconst
       EXTERNAL integrd,SCOPY
       EXTERNAL inigeom
Index: unk/LMDZ.GENERIC/libf/dyn3d/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/gr_dyn_fi.F	(revision 1402)
+++ 	(revision )
@@ -1,37 +1,0 @@
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-            ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: unk/LMDZ.GENERIC/libf/dyn3d/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/gr_fi_dyn.F	(revision 1402)
+++ 	(revision )
@@ -1,38 +1,0 @@
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: unk/LMDZ.GENERIC/libf/dyn3d/grid_noro1.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/grid_noro1.F	(revision 1402)
+++ 	(revision )
@@ -1,423 +1,0 @@
-      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
-     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Calcul des parametres de l'orographie sous-maille necessaires
-c      au nouveau shema de representation des montagnes meso-echelles
-c      dans le modele.  Les points sont mis sur une grille rectangulaire
-c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
-c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
-c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
-c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
-c      en j=1.  
-c      Les parametres a,b,c,d representent les limites de la region
-c      de point de grille correspondant a un point decrit precedemment.
-c      Les moyennes sur ces regions des valeurs calculees a partir de
-c      l'USN, sont ponderees par un poids, fonction de la surface
-c      occuppe par ces donnees a l'interieure de la grille du modele.
-c      Dans la plupart des cas ce poid est le rapport entre la surface
-c      de la region de point de grille USN et la surface de la region
-c      de point de grille du modele.
-c       
-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 et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c        dans ce programme, on assume que les donnees sont les altitudes
-c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        les champs de sorties sont sur une grille physique:
-c             zmea:  orographie moyenne
-c             zstd:  deviation standard de l'orographie sous-maille
-c             zsig:  pente de l'orographie sous-maille 
-c             zgam:  anisotropy de l'orographie sous maille
-c             zthe:  orientation de l'axe oriente dans la direction
-c                    de plus grande pente de l'orographie sous maille
-C=======================================================================
-c     IMPLICIT INTEGER (I,J)
-c     IMPLICIT REAL(X,Z) 
-       implicit none
-       integer iusn,jusn,iext
-       parameter(iusn=360,jusn=180,iext=40)
-c!-*-      include 'param1'
-c!-*-      include 'comcstfi.h'
-#include "dimensions.h"
-#include "comconst.h"
-c!-*-
-c!-*-      parameter(iim=cols,jjm=rows)
-      REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
-
-c   modif declarations pour implicit none
-      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
-      real zsigsud,zweinor,zweisud
-      real xk,xl,xm,xw,xp,xq
-      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
-      real zbordnor,zbordsud,zbordest,zbordoue,xpi
-      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
-      integer i,j,ii,jj,ideltax,ihalph
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL weight(iim+1,jjm+1)
-      REAL x(imar+1),y(jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-c
-c  quelques constantes:
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      print*,'rad =',rad
-      print*,'Long et lat entree'
-      print*,(x(i),i=1,imar+1)
-      print*,(y(j),j=1,jmar)
-       print*,'Long et lat donnees'
-      print*,(xdata(i),i=1,imdep)
-      print*,(ydata(j),j=1,jmdep)
-
-      xpi=acos(-1.)
-      zdeltay=2.*xpi/float(jusn)*rad
-c
-c  quelques tests de dimensions:
-c    
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
-        print *,' imar ou jmar mal dimensionnes:',imar,jmar
-        call abort
-      ENDIF
-c
-C  Extension de la base de donnee de l'USN pour faciliter
-C  les calculs ulterieurs:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=entree(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=entree(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=entree(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c
-c  Calcul d'une orographie filtree aux hautes latitudes
-c  pour permettre des calculs plus isotropiques sur la pente
-c  des montagnes
-c
-       DO i=1,IUSN+2*iext
-       DO J=1,JUSN+2
-          zusnfi(i,j)=0.0
-       ENDDO
-       ENDDO
-
-      DO j=1,jusn
-            ideltax=1./cos(yusn(j+1))
-            ideltax=min(iusn/2-1,ideltax)
-            IF(MOD(IDELTAX,2).EQ.0)THEN
-              IDELTAX=IDELTAX+1
-            ENDIF
-            IHALPH=(IDELTAX-1)/2 
-c           print *,' ideltax=',ideltax
-         IF(ideltax.eq.1)THEN
-            DO i=1,iusn
-               zusnfi(i+iext,j+1)=entree(i,j)
-            ENDDO   
-         ELSE
-            DO i=1,ihalph
-               DO ii=1,i+ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               DO ii=ihalph-i,0,-1
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
-               ENDDO  
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
-            ENDDO   
-            DO i=iusn-ihalph+1,iusn
-               DO ii = i-ihalph,iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO 
-               DO ii = 1,ihalph+i-iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
-            ENDDO
-            DO i=ihalph+1,iusn-ihalph
-               DO ii=-ihalph,ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
-            ENDDO
-         ENDIF
-            DO i=1,iext
-               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
-               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
-            ENDDO
-      ENDDO
-c  
-c Calculer les limites des zones des nouveaux points
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/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      quelques initialisations:
-      print*,'OKM1'
-c
-      DO i = 1, imar
-      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
-         zstd(i,j)=0.0
-      ENDDO
-      ENDDO
-c
-c  calculs des correlations de pentes sur la grille de l'USN.
-c
-         DO j = 2,jusn+1 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
-         ENDDO
-
-         ENDDO
-
- 
-
-      print*,'OK0'
-c
-c  sommations des differentes quantites definies precedemment
-c  sur une grille du modele.
-c 
-      zleny=xpi/float(jusn)*rad
-      xincr=xpi/2./float(jusn)
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=amax1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=amax1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            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
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  calculs des differents parametres necessaires au programme
-c  de parametrisation de l'orographie a l'echelle moyenne:
-c
-      zmaxmea=0.
-      zmaxstd=0.
-      zmaxsig=0.
-      zmaxgam=0.
-      zmaxthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       print*,'OK1'
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c       print*,'ok0'
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Orography moyenne:
-c         print*,'ok1'
-           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         print*,'ok2'
-c  Deviation standard:
-           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-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          print*,'ok3'
-c pente: 
-           zsig(ii,jj)=sqrt(xq)
-c           zsig(ii,jj)=sqrt(2.*xk)
-c isotropy:
-           zgam(ii,jj)=xp/xq
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
-
-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)     
-c          print*,'ok4'
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-c          print*,'ok1b'
-         ENDIF
-      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
-c         print*,'oka'
-      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
-c         print*,'okb'
-      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
-c         print*,'okc'
-      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
-c         print*,'okd'
-      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
-c         print*,'oke'
-      zminthe=amin1(zthe(ii,jj),zminthe)
-c      print*,'ok5'
-       ENDDO
-       ENDDO
-
-      print *,'  MEAN ORO:',zmaxmea
-	  print *,'  ST. DEV.:',zmaxstd
-      print *,'  PENTE:',zmaxsig
-      print *,' ANISOTROP:',zmaxgam
-      print *,'  ANGLE:',zminthe,zmaxthe	
-      
-C
-c  On passe ce donnees sur la grille dite physique....(?)
-c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
-c  n'ont pas vraiment de sens
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(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
-
-      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)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/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
Index: unk/LMDZ.GENERIC/libf/dyn3d/interp_vert.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/interp_vert.F	(revision 1402)
+++ 	(revision )
@@ -1,70 +1,0 @@
-c******************************************************
-      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
-     &             aps,bps,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**********************************************************
-
-      IMPLICIT NONE
-
-c   Declarations:
-c ==============
-c
-c  ARGUMENTS
-c  """""""""
-
-       integer lmo ! dimensions ancienne couches (input)
-       integer lmn ! dimensions nouvelle couches (input)
-
-       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
-       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (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
-
-c run
-c ====
-
-      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.GENERIC/libf/dyn3d/logic.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/logic.h	(revision 1402)
+++ /trunk/LMDZ.GENERIC/libf/dyn3d/logic.h	(revision 1403)
@@ -1,11 +1,11 @@
-c-----------------------------------------------------------------------
-c INCLUDE 'logic.h'
+!-----------------------------------------------------------------------
+! INCLUDE 'logic.h'
 
-      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
-     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,         &
+     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,      &
      &  hybrid,autozlevs
 
-      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
-     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid,autozlevs
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser, &
+     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid,autozlevs
 
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
Index: unk/LMDZ.GENERIC/libf/dyn3d/scal_wind.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/scal_wind.F	(revision 1402)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      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.GENERIC/libf/dyn3d/serre.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/serre.h	(revision 1402)
+++ /trunk/LMDZ.GENERIC/libf/dyn3d/serre.h	(revision 1403)
@@ -1,6 +1,6 @@
-c..include serre.h
-c
-       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
-       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+!..include serre.h
+!
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     & 
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: unk/LMDZ.GENERIC/libf/dyn3d/wind_scal.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dyn3d/wind_scal.F	(revision 1402)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      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.GENERIC/libf/dynlonlat_phylonlat/calfis.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
@@ -0,0 +1,558 @@
+      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
+     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
+     $            pducov,pdvcov,pdteta,pdq,pw,
+     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+      USE infotrac, ONLY: tname, nqtot
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       pw              flux vertical (kg/s)
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature
+c        pdtsfi         tendency for the surface temperature
+c
+c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+
+      INTEGER ngridmx,nq
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+
+!#include "advtrac.h"
+!! this is to get tnom (tracers name)
+
+c    Arguments :
+c    -----------
+      LOGICAL  lafin
+      REAL heure
+
+      REAL pvcov(iip1,jjm,llm)
+      REAL pucov(iip1,jjp1,llm)
+      REAL pteta(iip1,jjp1,llm)
+      REAL pmasse(iip1,jjp1,llm)
+      REAL pq(iip1,jjp1,llm,nqtot)
+      REAL pphis(iip1,jjp1)
+      REAL pphi(iip1,jjp1,llm)
+c
+      REAL pdvcov(iip1,jjm,llm)
+      REAL pducov(iip1,jjp1,llm)
+      REAL pdteta(iip1,jjp1,llm)
+      REAL pdq(iip1,jjp1,llm,nqtot)
+c
+      REAL pw(iip1,jjp1,llm)
+c
+      REAL pps(iip1,jjp1)
+      REAL pp(iip1,jjp1,llmp1)
+      REAL ppk(iip1,jjp1,llm)
+c
+      REAL pdvfi(iip1,jjm,llm)
+      REAL pdufi(iip1,jjp1,llm)
+      REAL pdhfi(iip1,jjp1,llm)
+      REAL pdqfi(iip1,jjp1,llm,nqtot)
+      REAL pdpsfi(iip1,jjp1)
+      logical tracer
+
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+c
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
+c
+      REAL zvervel(ngridmx,llm)
+c
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
+      REAL zdpsrf(ngridmx)
+c
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+c
+      
+      EXTERNAL gr_dyn_fi,gr_fi_dyn
+      EXTERNAL physiq,multipl
+      REAL SSUM
+      EXTERNAL SSUM
+
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+
+      LOGICAL firstcal, debut
+      DATA firstcal/.true./
+      SAVE firstcal,debut
+      REAL rdayvrai,rday_ecri
+c
+c-----------------------------------------------------------------------
+c
+c    1. Initialisations :
+c    --------------------
+c
+
+
+      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         PRINT*,'STOP dans calfis'
+         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         PRINT*,'  ngridmx  jjm   iim   '
+         PRINT*,ngridmx,jjm,iim
+         STOP
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   latitude, longitude et aires des mailles pour la physique:
+c   ----------------------------------------------------------
+
+c
+      IF ( firstcal )  THEN
+          debut = .TRUE.
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+c
+!      IF (firstcal) THEN
+!         latfi(1)=rlatu(1)
+!         lonfi(1)=0.
+!         DO j=2,jjm
+!            DO i=1,iim
+!               latfi((j-2)*iim+1+i)= rlatu(j)
+!               lonfi((j-2)*iim+1+i)= rlonv(i)
+!            ENDDO
+!         ENDDO
+!         latfi(ngridmx)= rlatu(jjp1)
+!         lonfi(ngridmx)= 0.
+!
+!         ! build airefi(), mesh area on physics grid
+!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+!         ! Poles are single points on physics grid
+!         airefi(1)=airefi(1)*iim
+!         airefi(ngridmx)=airefi(ngridmx)*iim
+!
+!         CALL inifis(ngridmx,llm,day_ini,daysec,dtphys,
+!     .                latfi,lonfi,airefi,rad,g,r,cpp)
+!      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+
+c   42. pression intercouches :
+c
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+c
+       unskap   = 1./ kappa
+c
+      DO l = 1, llmp1
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+c
+c
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
+         ig0         =  2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
+
+      ENDDO
+
+      DO l=1, llm
+        DO ig=1,ngridmx
+             if (ztfi(ig,l).lt.15) then
+                  write(*,*) 'New Temperature below 15 K !!! '
+	              write(*,*) 'Stop in calfis.F '
+	              write(*,*) 'ig=', ig, ' l=', l
+                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
+                  stop
+             end if
+        ENDDO
+      ENDDO
+
+
+
+c   43.bis Taceurs (en kg/kg)
+c   --------------------------
+      DO iq=1,nqtot
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+            zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
+c   -------------------------------
+c     pw est en kg/s
+c On interpole "lineairement" la temperature entre les couches(FF,10/95)
+
+!      DO ig=1,ngridmx
+!         zvervel(ig,1)=0.
+!      END DO
+!      DO l=2,llm
+!        zvervel(1,l)=(pw(1,1,l)/apoln)
+!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
+!        ig0=2
+!       DO j=2,jjm
+!           DO i = 1, iim
+!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!              ig0 = ig0 + 1
+!           ENDDO
+!       ENDDO
+!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
+!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!      ENDDO
+
+c    .........  Reindexation : calcul de zvervel au MILIEU des couches
+!       DO l=1,llm-1
+!	      DO ig=1,ngridmx
+!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
+!          END DO 
+!       END DO 
+c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
+
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+      ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+      ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+
+      CALL physiq (ngridmx,llm,nq,
+     .     tname,
+     ,     debut,lafin,
+     ,     rday_ecri,heure,dtphys,
+     ,     zplev,zplay,zphi,
+     ,     zufi, zvfi,ztfi, zqfi,  
+!     ,     zvervel,
+     ,     pw,
+C - sorties
+     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
+
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
+
+c   62. enthalpie potentielle
+c   ---------------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
+            ENDDO
+               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   62. traceurs
+c   ---------------------
+
+      DO iq=1,nqtot
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+      ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+
+      firstcal = .FALSE.
+
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,37 @@
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
@@ -0,0 +1,38 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,454 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+!$OMP THREADPRIVATE(nbp_lon,nbp_lat,nbp_lev,klon_glo)
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,218 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  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
+!!$OMP THREADPRIVATE(ii_begin,ii_end,jj_begin,jj_end,jj_nb,ij_begin,&
+!	!$OMP ij_end,ij_nb,klon_mpi_begin,klon_mpi_end,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 
+!!$OMP THREADPRIVATE(jj_para_nb,jj_para_begin,jj_para_end,ii_para_begin,ii_para_end,&
+!	!$OMP ij_para_nb,ij_para_begin,ij_para_end,klon_mpi_para_nb,klon_mpi_para_begin,&
+!	!$OMP 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
+!!$OMP THREADPRIVATE(mpi_rank,mpi_size,mpi_root,is_mpi_root,is_using_mpi)
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+!!$OMP THREADPRIVATE(is_north_pole,is_south_pole,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
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      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(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1906 @@
+!
+!$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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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)
+    if (ierr.ne.MPI_SUCCESS) then
+      write(*,*) "bcast_mpi error: ierr=",ierr
+      stop
+    endif
+#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.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -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(*,*)'--------> TASK ',omp_rank
+  WRITE(*,*)'omp_size =',omp_size
+  WRITE(*,*)'omp_rank =',omp_rank
+  WRITE(*,*)'is_omp_root =',is_omp_root
+  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(*,*)'klon_omp =',klon_omp
+  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(*,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -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, only: klon_omp, klon_omp_begin
+    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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,115 @@
+!
+!$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)
+!$OMP THREADPRIVATE(is_sequential,is_parallel)
+  
+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, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
+                               grid1dTo2d_glo, grid2dTo1d_glo
+  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(*,*) "------> 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(*,*) "------> 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(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -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.GENERIC/libf/dynlonlat_phylonlat/phystd/caldyn0.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/caldyn0.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/caldyn0.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/caldyn0.F
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/datareadnc.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/datareadnc.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/datareadnc.F	(revision 1403)
@@ -0,0 +1,283 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,filename,phisinit,alb,ith,
+     .                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+      use datafile_mod, only: datadir
+! to use  'getin'
+      USE ioipsl_getincom 
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+      character(len=3),intent(inout) :: relief*3
+      character(len=*),intent(in) :: filename ! surface.nc file
+      real,intent(out) :: phisinit(iimp1*jjp1) ! surface geopotential
+      real,intent(out) :: alb(iimp1*jjp1) ! albedo
+      real,intent(out) :: ith(iimp1*jjp1) ! thermal inertia
+      real,intent(out) :: zmea(imdp1*jmdp1)
+      real,intent(out) :: zstd(imdp1*jmdp1)
+      real,intent(out) :: zsig(imdp1*jmdp1)
+      real,intent(out) :: zgam(imdp1*jmdp1)
+      real,intent(out) :: zthe(imdp1*jmdp1)
+      
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      INTEGER   ierr
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmixgdat
+      PARAMETER (klatdat=180,ngridmixgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(4)
+
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      ierr = NF_OPEN (trim(datadir)//'/'//trim(adjustl(filename)),
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file '//trim(filename)
+        write(*,*)'(in phystd/datareadnc.F)'
+        write(*,*)'It should be in :',trim(datadir),'/'
+        write(*,*)'Check that your path to datagcm:',trim(datadir)
+        write(*,*)' is correct. You can change it in callphys.def with:'
+        write(*,*)' datadir = /absolute/path/to/datagcm'
+        write(*,*)'If necessary surface.nc (and other datafiles)'
+        write(*,*)' can be obtained online on:'
+        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
+        STOP
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' La topographie est celle de MOLA'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=1,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      pfield(1:iimp1*jjp1)=0
+      zdata(1:imd*jmdp1)=0
+      zdataS(1:iimp1*jjp1)=0
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          zdata(:)=1000.*zdata(:)
+          longitude(:)=(pi/180.)*longitude(:)
+          latitude(:)=(pi/180.)*latitude(:)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          !CALL dump2d(iip1,jjp1,zmea,'zmea')
+          !CALL dump2d(iip1,jjp1,zstd,'zstd')
+          !CALL dump2d(iip1,jjp1,zsig,'zsig')
+          !CALL dump2d(iip1,jjp1,zgam,'zgam')
+          !CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmixgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmixgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+             phisinit(1:iimp1*jjp1)=0
+        else
+             phisinit(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      phisinit(1:iimp1*jjp1)=1000.*phisinit(1:iimp1*jjp1)
+      !CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
+      phisinit(:)=g*phisinit(:)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/defrun_new.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/defrun_new.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/defrun_new.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/defrun_new.F
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/exner_hyb.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/exner_hyb.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/exner_hyb.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/exner_hyb.F
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/grid_noro1.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/grid_noro1.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/grid_noro1.F	(revision 1403)
@@ -0,0 +1,423 @@
+      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
+     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Calcul des parametres de l'orographie sous-maille necessaires
+c      au nouveau shema de representation des montagnes meso-echelles
+c      dans le modele.  Les points sont mis sur une grille rectangulaire
+c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
+c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
+c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
+c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
+c      en j=1.  
+c      Les parametres a,b,c,d representent les limites de la region
+c      de point de grille correspondant a un point decrit precedemment.
+c      Les moyennes sur ces regions des valeurs calculees a partir de
+c      l'USN, sont ponderees par un poids, fonction de la surface
+c      occuppe par ces donnees a l'interieure de la grille du modele.
+c      Dans la plupart des cas ce poid est le rapport entre la surface
+c      de la region de point de grille USN et la surface de la region
+c      de point de grille du modele.
+c       
+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 et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c        dans ce programme, on assume que les donnees sont les altitudes
+c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        les champs de sorties sont sur une grille physique:
+c             zmea:  orographie moyenne
+c             zstd:  deviation standard de l'orographie sous-maille
+c             zsig:  pente de l'orographie sous-maille 
+c             zgam:  anisotropy de l'orographie sous maille
+c             zthe:  orientation de l'axe oriente dans la direction
+c                    de plus grande pente de l'orographie sous maille
+C=======================================================================
+c     IMPLICIT INTEGER (I,J)
+c     IMPLICIT REAL(X,Z) 
+       implicit none
+       integer iusn,jusn,iext
+       parameter(iusn=360,jusn=180,iext=40)
+c!-*-      include 'param1'
+c!-*-      include 'comcstfi.h'
+#include "dimensions.h"
+#include "comconst.h"
+c!-*-
+c!-*-      parameter(iim=cols,jjm=rows)
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
+
+c   modif declarations pour implicit none
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
+      real zsigsud,zweinor,zweisud
+      real xk,xl,xm,xw,xp,xq
+      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
+      real zbordnor,zbordsud,zbordest,zbordoue,xpi
+      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
+      integer i,j,ii,jj,ideltax,ihalph
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL weight(iim+1,jjm+1)
+      REAL x(imar+1),y(jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+c  quelques constantes:
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      print*,'rad =',rad
+      print*,'Long et lat entree'
+      print*,(x(i),i=1,imar+1)
+      print*,(y(j),j=1,jmar)
+       print*,'Long et lat donnees'
+      print*,(xdata(i),i=1,imdep)
+      print*,(ydata(j),j=1,jmdep)
+
+      xpi=acos(-1.)
+      zdeltay=2.*xpi/float(jusn)*rad
+c
+c  quelques tests de dimensions:
+c    
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
+        print *,' imar ou jmar mal dimensionnes:',imar,jmar
+        call abort
+      ENDIF
+c
+C  Extension de la base de donnee de l'USN pour faciliter
+C  les calculs ulterieurs:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=entree(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=entree(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=entree(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c
+c  Calcul d'une orographie filtree aux hautes latitudes
+c  pour permettre des calculs plus isotropiques sur la pente
+c  des montagnes
+c
+       DO i=1,IUSN+2*iext
+       DO J=1,JUSN+2
+          zusnfi(i,j)=0.0
+       ENDDO
+       ENDDO
+
+      DO j=1,jusn
+            ideltax=1./cos(yusn(j+1))
+            ideltax=min(iusn/2-1,ideltax)
+            IF(MOD(IDELTAX,2).EQ.0)THEN
+              IDELTAX=IDELTAX+1
+            ENDIF
+            IHALPH=(IDELTAX-1)/2 
+c           print *,' ideltax=',ideltax
+         IF(ideltax.eq.1)THEN
+            DO i=1,iusn
+               zusnfi(i+iext,j+1)=entree(i,j)
+            ENDDO   
+         ELSE
+            DO i=1,ihalph
+               DO ii=1,i+ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               DO ii=ihalph-i,0,-1
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
+               ENDDO  
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO   
+            DO i=iusn-ihalph+1,iusn
+               DO ii = i-ihalph,iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO 
+               DO ii = 1,ihalph+i-iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+            DO i=ihalph+1,iusn-ihalph
+               DO ii=-ihalph,ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/float(ideltax)
+            ENDDO
+         ENDIF
+            DO i=1,iext
+               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
+               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
+            ENDDO
+      ENDDO
+c  
+c Calculer les limites des zones des nouveaux points
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/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      quelques initialisations:
+      print*,'OKM1'
+c
+      DO i = 1, imar
+      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
+         zstd(i,j)=0.0
+      ENDDO
+      ENDDO
+c
+c  calculs des correlations de pentes sur la grille de l'USN.
+c
+         DO j = 2,jusn+1 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
+         ENDDO
+
+         ENDDO
+
+ 
+
+      print*,'OK0'
+c
+c  sommations des differentes quantites definies precedemment
+c  sur une grille du modele.
+c 
+      zleny=xpi/float(jusn)*rad
+      xincr=xpi/2./float(jusn)
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=amax1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=amax1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            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
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  calculs des differents parametres necessaires au programme
+c  de parametrisation de l'orographie a l'echelle moyenne:
+c
+      zmaxmea=0.
+      zmaxstd=0.
+      zmaxsig=0.
+      zmaxgam=0.
+      zmaxthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       print*,'OK1'
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c       print*,'ok0'
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Orography moyenne:
+c         print*,'ok1'
+           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         print*,'ok2'
+c  Deviation standard:
+           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+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          print*,'ok3'
+c pente: 
+           zsig(ii,jj)=sqrt(xq)
+c           zsig(ii,jj)=sqrt(2.*xk)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+
+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)     
+c          print*,'ok4'
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+c          print*,'ok1b'
+         ENDIF
+      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
+c         print*,'oka'
+      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
+c         print*,'okb'
+      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
+c         print*,'okc'
+      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
+c         print*,'okd'
+      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
+c         print*,'oke'
+      zminthe=amin1(zthe(ii,jj),zminthe)
+c      print*,'ok5'
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zmaxmea
+	  print *,'  ST. DEV.:',zmaxstd
+      print *,'  PENTE:',zmaxsig
+      print *,' ANISOTROP:',zmaxgam
+      print *,'  ANGLE:',zminthe,zmaxthe	
+      
+C
+c  On passe ce donnees sur la grille dite physique....(?)
+c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
+c  n'ont pas vraiment de sens
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(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
+
+      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)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/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
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/ini_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/ini_archive.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/ini_archive.F	(revision 1403)
@@ -0,0 +1,530 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi,
+     &                       tab_cntrl_dyn)
+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	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       ith            soil thermal inertia
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+
+      USE comsoil_h
+!      use control_mod
+      implicit none
+
+#include "dimensions.h"
+!#include "dimphys.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "serre.h"
+!#include "control.h"
+
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL		tab_cntrl(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      real ith(ip1jmp1,nsoilmx)
+      REAL		tab_cntrl_fi(length)
+      REAL tab_cntrl_dyn(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 idim_nsoilmx ! "subsurface_layers" dimension ID #
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+      
+      tab_cntrl(1:50)=tab_cntrl_dyn(1:50)
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!      tab_cntrl(1)  = FLOAT(iim) ! nombre de points en longitude
+!      tab_cntrl(2)  = FLOAT(jjm) ! nombre de points en latitude
+!      tab_cntrl(3)  = FLOAT(llm) ! nombre de couches
+!      tab_cntrl(4)  = FLOAT(idayref) ! jour 0
+!      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+!      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+!      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+!      tab_cntrl(8)  = cpp 
+!      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+!      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+!      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+!      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+!      tab_cntrl(12) = etot0 ! energie totale    !
+!      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+!      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+!      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+!      tab_cntrl(16) = ang0 ! moment cinetique  !
+!      tab_cntrl(17) = pa
+!      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+!      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+!      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+!      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+!      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+!      IF ( fxyhypb )   THEN
+!       tab_cntrl(23) = 1.
+!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+!      ELSE
+!       tab_cntrl(23) = 0.
+!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+!       tab_cntrl(26) = 0.
+!       IF ( ysinus)  tab_cntrl(26) = 1.
+!      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau tab_cntrl
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+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", 21,
+     &                       "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, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", 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-----------------------------------------------------------------------
+
+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,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#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  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c--------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+!---------------------
+! soil thermal inertia
+!---------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      dims3(1)=idim_rlonv
+      dims3(2)=idim_rlatu
+      dims3(3)=idim_nsoilmx
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     &                        "Soil thermal inertia")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
+     &                        "J.s-1/2.m-2.K-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
+#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
+
+      PRINT*,'ini_archive: iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'ini_archive: rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,tab_cntrl_fi(8),kappa
+      PRINT*,'ini_archive: daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,145 @@
+subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use dimphy, only : klev ! number of atmospheric levels
+use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
+                                       ! (on full grid)
+use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
+                               klon_omp_begin, & ! start index of local omp subgrid
+                               klon_omp_end, & ! end index of local omp subgrid
+                               klon_mpi_begin ! start indes of columns (on local mpi grid)
+
+use comgeomphy, only : initcomgeomphy, &
+                       airephy, & ! physics grid area (m2)
+                       cuphy, & ! cu coeff. (u_covariant = cu * u)
+                       cvphy, & ! cv coeff. (v_covariant = cv * v)
+                       rlond, & ! longitudes
+                       rlatd ! latitudes
+use infotrac, only : nqtot ! number of advected tracers
+use planete_mod, only: ini_planete_mod
+
+implicit none
+include "dimensions.h"
+include "comvert.h"
+include "iniprint.h"
+
+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 (full grid)
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
+integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
+real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
+real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
+real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
+real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: cv((ii+1)*jj) ! 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 :: ibegin,iend,offset
+integer :: i,j
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+real :: total_area_phy, total_area_dyn
+
+
+! global array, on full physics grid:
+real,allocatable :: latfi(:)
+real,allocatable :: lonfi(:)
+real,allocatable :: cufi(:)
+real,allocatable :: cvfi(:)
+real,allocatable :: airefi(:)
+
+IF (nlayer.NE.klev) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'nlayer     = ',nlayer
+  write(*,*) 'klev   = ',klev
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+!IF (ngrid.NE.klon_glo) THEN
+!  write(*,*) 'STOP in ',trim(modname)
+!  write(*,*) 'Problem with dimensions :'
+!  write(*,*) 'ngrid     = ',ngrid
+!  write(*,*) 'klon   = ',klon_glo
+!  abort_message = ''
+!  CALL abort_gcm (modname,abort_message,1)
+!ENDIF
+
+!call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+
+! Generate global arrays on full physics grid
+allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+latfi(1)=rlatu(1)
+lonfi(1)=0.
+cufi(1) = cu(1)
+cvfi(1) = cv(1)
+DO j=2,jj
+  DO i=1,ii
+    latfi((j-2)*ii+1+i)= rlatu(j)
+    lonfi((j-2)*ii+1+i)= rlonv(i)
+    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
+    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
+  ENDDO
+ENDDO
+latfi(klon_glo)= rlatu(jj+1)
+lonfi(klon_glo)= 0.
+cufi(klon_glo) = cu((ii+1)*jj+1)
+cvfi(klon_glo) = cv((ii+1)*jj-ii)
+
+! build airefi(), mesh area on physics grid
+allocate(airefi(klon_glo))
+CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
+! Poles are single points on physics grid
+airefi(1)=sum(aire(1:ii,1))
+airefi(klon_glo)=sum(aire(1:ii,jj+1))
+
+! Sanity check: do total planet area match between physics and dynamics?
+total_area_dyn=sum(aire(1:ii,1:jj+1))
+total_area_phy=sum(airefi(1:klon_glo))
+IF (total_area_dyn/=total_area_phy) THEN
+  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+    ! stop here if the relative difference is more than 0.001%
+    abort_message = 'planet total surface discrepancy'
+    CALL abort_gcm(modname, abort_message, 1)
+  ENDIF
+ENDIF
+
+
+!$OMP PARALLEL 
+! Now generate local lon/lat/cu/cv/area arrays
+call initcomgeomphy
+
+!!!!$OMP PARALLEL PRIVATE(ibegin,iend) & 
+!!!	!$OMP SHARED(airefi,cufi,cvfi,lonfi,latfi)
+
+offset=klon_mpi_begin-1
+airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy over preff , ap() and bp() 
+call ini_planete_mod(nlayer,preff,ap,bp)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call inifis(klon_omp,nlayer,nqtot,pdayref,punjours,ptimestep, &
+            rlatd,rlond,airephy,prad,pg,pr,pcpp)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/interp_vert.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/interp_vert.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/interp_vert.F	(revision 1403)
@@ -0,0 +1,70 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
+     &             aps,bps,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**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (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
+
+c run
+c ====
+
+      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.GENERIC/libf/dynlonlat_phylonlat/phystd/lect_start_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/lect_start_archive.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/lect_start_archive.F	(revision 1403)
@@ -0,0 +1,1495 @@
+      SUBROUTINE lect_start_archive(ngrid,nlayer,
+     &     date,tsurf,tsoil,emis,q2,
+     &     t,ucov,vcov,ps,h,phisold_newgrid,
+     &     q,qsurf,surfith,nid,
+     &     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+!      USE surfdat_h
+      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
+      USE tracer_h, ONLY: igcm_co2_ice
+      USE infotrac, ONLY: tname, nqtot
+      USE slab_ice_h, ONLY: noceanmx
+!      USE control_mod
+! to use  'getin'
+      USE callkeys_mod, ONLY: ok_slab_ocean
+
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+
+      implicit none
+
+#include "dimensions.h"
+!#include "dimphys.h"
+!#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+!#include "logic.h"
+#include "ener.h"
+#include "temps.h"
+#include "netcdf.inc"
+!#include"advtrac.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+      INTEGER,INTENT(IN) :: ngrid, nlayer
+
+c Old variables dimensions (from file)
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nsoilold,nqold
+
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+!      INTEGER sizei,
+      integer timelen,dimid
+!      INTEGER length
+!      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+!      CHARACTER*120 dimsource
+!      CHARACTER*16 dimname
+!      CHARACTER*80 dimtitle
+!      CHARACTER*40 dimunits
+!      INTEGER   dimtype
+
+!      INTEGER dimord(4)  ! tableau contenant l''ordre
+!      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+!      INTEGER vardim(4)
+      REAL date
+      INTEGER   memo
+!      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+!      integer klatdat,klongdat
+!      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+      REAL tsurf(ngrid) ! surface temperature
+      REAL tsoil(ngrid,nsoilmx) ! soil temperature
+      REAL co2ice(ngrid) ! CO2 ice layer
+      REAL emis(ngrid)
+      REAL q2(ngrid,llm+1),qsurf(ngrid,nqtot)
+      REAL tslab(ngrid,noceanmx)
+      REAL rnat(ngrid),pctsrf_sic(ngrid)
+      REAL tsea_ice(ngrid),sea_ice(ngrid)
+c     REAL phisfi(ngrid)
+
+      INTEGER i,j,l
+      INTEGER nid,nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2)
+c     REAL iceradius(2) , dtemisice(2)
+
+      integer ierr
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      REAL phisold_newgrid(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real inertiedatS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1)
+      real emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
+      real tslabS(iip1,jjp1,noceanmx)
+      real pctsrf_sicS(iip1,jjp1),tsea_iceS(iip1,jjp1)
+      real rnatS(iip1,jjp1), sea_iceS(iip1,jjp1)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:), allocatable :: mlayerold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:,:),allocatable :: tsoiloldnew
+! tsoiloldnew: old soil values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatold
+! inertiedatoldnew: old inertia values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatoldnew
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold
+      real, dimension(:,:), allocatable :: tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+      real, dimension(:,:,:), allocatable :: tslabold
+      real, dimension(:,:), allocatable :: rnatold,pctsrf_sicold
+      real, dimension(:,:), allocatable :: tsea_iceold,sea_iceold
+
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+      logical :: olddepthdef=.false. ! flag
+! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
+      logical :: depthinterpol=.false. ! flag
+! depthinterpol=.true. if interpolation will be requiered
+      logical :: therminertia_3D=.true. ! flag
+! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+      real, dimension(:), allocatable :: oldgrid, oldval
+      real, dimension(:), allocatable :: newval
+
+      real surfith(iip1,jjp1) ! surface thermal inertia
+      ! surface thermal inertia at old horizontal grid resolution
+      real, dimension(:,:), allocatable :: surfithold 
+
+      character(len=30) :: txt ! to store some text
+
+c=======================================================================
+
+! 0. Preliminary stuff
+
+
+
+!-----------------------------------------------------------------------
+! 1. Read data dimensions (i.e. size and length)
+!-----------------------------------------------------------------------
+
+! 1.2 Read the various dimension lengths of data in file 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+! 1.2.1 find out the # of subsurface_layers
+      nsoilold=0 !dummy initialisation
+      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+      if (ierr.eq.NF_NOERR) then
+        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'lec_start_archive: ',
+     &              'Failed reading subsurface_layers length'
+	endif
+      else
+        write(*,*)"lec_start_archive: did not find subsurface_layers"
+      endif
+
+      if (nsoilold.eq.0) then ! 'old' archive format;
+      ! must use Tg//str2 fields to compute nsoilold
+      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
+        do
+	 write(str2,'(i2.2)') nsoilold+1
+	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
+	 if (ierr.eq.NF_NOERR) then
+	  nsoilold=nsoilold+1
+	 else
+	  exit
+	 endif
+	enddo
+      endif
+
+
+      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
+        depthinterpol=.true.
+      endif
+
+! 1.3 Report dimensions
+      
+      write(*,*) "Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      write(*,*) "tracers: ",nqold
+      write(*,*) "subsurface_layers: ",nsoilold
+      if (depthinterpol) then
+      write(*,*) " => Warning, nsoilmx= ",nsoilmx
+      write(*,*) '    which implies that you want subterranean interpola
+     &tion.'
+      write(*,*) '  Otherwise, set nsoilmx -in dimphys.h- to: ',nsoilold
+      endif
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+!-----------------------------------------------------------------------
+! 2. Allocate arrays to store datasets
+!-----------------------------------------------------------------------
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqtot))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(tsoilold(imold+1,jmold+1,nsoilold))
+      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
+      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
+      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
+      ! surface thermal inertia at old horizontal grid resolution
+      allocate(surfithold(imold+1,jmold+1))
+      allocate(mlayerold(nsoilold))
+      allocate(qsurfold(imold+1,jmold+1,nqtot))
+      allocate(tslabold(imold+1,jmold+1,noceanmx))
+      allocate(rnatold(imold+1,jmold+1))
+      allocate(pctsrf_sicold(imold+1,jmold+1))
+      allocate(tsea_iceold(imold+1,jmold+1))
+      allocate(sea_iceold(imold+1,jmold+1))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngrid,llm+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+
+!-----------------------------------------------------------------------
+! 3. Read time-independent data
+!-----------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+c 3.1. Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: 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*, "lect_start_archive: Lecture echoue pour <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c 3.2 Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
+         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*, "lect_start_archive: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
+         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*, "lect_start_archive: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
+         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*, "lect_start_archive: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
+         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*, "lect_start_archive: Lecture echouee pour <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c 3.3. Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <aps> est absent"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <bps> est absent"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
+         CALL abort
+      END IF
+
+c-----------------------------------------------------------------------
+c 3.4 Read Soil layers depths
+c-----------------------------------------------------------------------
+     
+      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <soildepth>'
+       write(*,*)' => Assuming this is an archive in old format'
+       olddepthdef=.true.
+       depthinterpol=.true.
+       ! this is how soil depth was defined in ye old days
+	do isoil=1,nsoilold
+	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
+	enddo
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+
+      endif !of if(ierr.ne.NF_NOERR)
+
+      ! Read (or build) mlayer()
+      if (depthinterpol) then
+       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
+       ! as in soil_settings.F
+       write(*,*)' => Building default soil depths'
+       do isoil=0,nsoilmx-1
+         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
+       enddo
+       write(*,*)' => mlayer: ',mlayer
+       ! Also build (default) new soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+       write(*,*)' =>  layer: ',layer
+      else ! read mlayer() from file
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+      endif ! of if (depthinterpol)
+
+c-----------------------------------------------------------------------
+c 3.5 Read Soil thermal inertia
+c-----------------------------------------------------------------------
+
+      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <inertiedat>'
+       write(*,*)' => Assuming this is an archive in old format'
+       therminertia_3D=.false.
+       write(*,*)' => Thermal inertia will be read from reference file'
+       volcapa=1.e6
+       write(*,*)'    and soil volumetric heat capacity is set to ',
+     &           volcapa
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
+         CALL abort
+       endif
+      endif
+
+c-----------------------------------------------------------------------
+c 3.6 Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
+         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*, "lect_start_archive: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c 4. Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Le champ <Time> est absent"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Differentes dates des etats initiaux stockes:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+        write(*,*) 'etat initial au jour martien' ,int(timelist(i))
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choix de la date'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+        if (date.eq.int(timelist(i))) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'He alors... Y sait pas lire !?!'
+        write(*,*)
+        write(*,*) 'Differentes dates des etats initiaux stockes:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+
+!-----------------------------------------------------------------------
+! 5. Read (time-dependent) data from datafile
+!-----------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], qsurf)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+! CO2ice is now in qsurf(igcm_co2_ice) ...
+!      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+!      IF (ierr .NE. NF_NOERR) THEN
+!         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
+!         CALL abort
+!      ENDIF
+!#ifdef NC_DOUBLE
+!      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+!#else
+!      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+!#endif
+!      IF (ierr .NE. NF_NOERR) THEN
+!         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
+!         PRINT*, NF_STRERROR(ierr)
+!         CALL abort
+!      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <emis> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
+         CALL abort
+      ENDIF
+c
+      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,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,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,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
+         CALL abort
+      ENDIF
+c
+cc Slab ocean
+      if(ok_slab_ocean) then
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,noceanmx,1/)
+
+       ierr=NF_INQ_VARID(nid,"tslab",nvarid)
+       IF (ierr.ne.NF_NOERR) then
+          PRINT*,"lect_start_archive: Cannot find <tslab>"
+       ENDIF
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tslabold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tslabold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tslab>"
+      ENDIF
+
+
+c
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+
+      ierr = NF_INQ_VARID (nid, "rnat", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <rnat> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,rnatold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,rnatold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <rnat>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "pctsrf_sic", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <pctsrf_sic> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,pctsrf_sicold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,pctsrf_sicold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <pctsrf_sic>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsea_ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsea_ice> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsea_iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsea_iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsea_ice>"
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "sea_ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <sea_ice> est absent"
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,sea_iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,sea_iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <sea_ice>"
+      ENDIF
+  
+      ENDIF! ok_slab_ocean
+c
+      write(*,*)"lect_start_archive: rlonuold:"
+     &           ,rlonuold," rlatvold:",rlatvold
+      write(*,*)
+
+! Surface tracers:      
+      do iq=1,nqtot
+        ! initialize all surface tracers to zero
+        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+      enddo
+
+
+!      print*,'tname=',tname
+!      print*,'nid',nid
+!      print*,'nvarid',nvarid
+!      stop
+
+      DO iq=1,nqtot
+          txt=trim(tname(iq))//"_surf"
+          if (txt.eq."h2o_vap") then
+            ! There is no surface tracer for h2o_vap;
+            ! "h2o_ice" should be loaded instead
+            txt="h2o_ice_surf"
+            write(*,*) 'lect_start_archive: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+          endif
+
+        
+        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+
+!          print*,'RDW has added hack to let me continue...'
+!          CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#else
+        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             " Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'    is set to 0'
+!          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+!-----------------------------------------------------------------------
+! 5.2 Read 3D subterranean fields
+!-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+!
+! Read soil temperatures
+!
+      if (olddepthdef) then ! tsoil stored using the 'old format'
+         start=(/1,1,memo,0/)
+         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
+       do isoil=1,nsoilold
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              "Field <","Tg"//str2,"> not found"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &            "Failed reading <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+       enddo ! of do isoil=1,nsoilold
+      
+      ! reset 'start' and 'count' to "3D" behaviour
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+      
+      else
+       write(*,*) "lect_start_archive: loading tsoil "
+       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+       if (ierr.ne.NF_NOERR) then
+        write(*,*)"lect_start_archive: Cannot find <tsoil>"
+	call abort
+       else
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
+#endif
+       endif ! of if (ierr.ne.NF_NOERR)
+       
+      endif ! of if (olddepthdef)
+
+!
+! Read soil thermal inertias
+!
+!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
+!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
+!	call abort
+!       else
+!#ifdef NC_DOUBLE
+!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
+!#else
+!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
+!#endif
+!       endif ! of if (ierr.ne.NF_NOERR)
+!      endif
+
+c-----------------------------------------------------------------------
+c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/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, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, 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,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,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,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+! Tracers:      
+      do iq=1,nqtot
+         call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
+      enddo
+
+      DO iq=1,nqtot
+        txt=tname(iq)
+        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+!            CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+        ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+        ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &             "  Failed loading <",trim(txt),">"
+          write (*,*) trim(txt),'      set to 1.E-30'
+          do l=1,lmold
+            do j=1,jmold+1
+              do i=1,imold+1
+                 qold(i,j,l,iq)=1.e-30
+              end do
+            end do
+          end do
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+!=======================================================================
+! 6. Interpolation from old grid to new grid
+!=======================================================================
+
+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 6.1	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+! CO2 ice is now in qsurf(igcm_co2_ice)
+!      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+!     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,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,iim+1,jjm+1,ngrid,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
+c     write(46,*) 'emis',emis
+
+
+
+c-----------------------------------------------------------------------
+c 6.1.2	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-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+         END DO
+      END DO
+      co2icetotal = 0.
+      if (igcm_co2_ice.ne.0) then
+        ! recast surface CO2 ice on new grid
+        call interp_horiz(qsurfold(1,1,igcm_co2_ice),
+     &                  qsurfs(1,1,igcm_co2_ice),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+       DO j=1,jjp1
+         DO i=1,iim
+           !co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+           co2icetotal=co2icetotal+qsurfS(i,j,igcm_co2_ice)*aire(i,j)
+         END DO
+       END DO
+      else
+        write(*,*) "Warning: No co2_ice surface tracer"
+      endif
+
+      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(*,*)
+      write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
+      write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
+      if (co2icetotalold.ne.0.) then
+      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
+      endif
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+!         DO j=1,jjp1
+!            DO i=1,iip1
+!               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+!            END DO
+!         END DO
+        write(*,*) "Not enforcing conservation of surface CO2 ice"
+        write(*,*) " (should be OK when CO2 ice is a tracer)"
+      end if
+
+c-----------------------------------------------------------------------
+c 6.2 Subterranean 3d variables:
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c 6.2.1 Thermal Inertia
+c       Note: recall that inertiedat is a common in "comsoil.h"
+c-----------------------------------------------------------------------
+
+      ! depth-wise interpolation, if required
+      if (depthinterpol.and.(.not.olddepthdef)) then
+        allocate(oldval(nsoilold))
+	allocate(newval(nsoilmx))
+        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
+     &f soil thermal inertia; might be wiser to reset it.'
+        write(*,*)
+       
+        do i=1,imold+1
+         do j=1,jmold+1
+	   !copy old values
+	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
+	   !interpolate
+	   call interp_line(mlayerold,oldval,nsoilold,
+     &                     mlayer,newval,nsoilmx)
+           !copy interpolated values
+           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+        enddo
+        ! cleanup
+	deallocate(oldval)
+	deallocate(newval)
+      endif !of if (depthinterpol)
+
+      if (therminertia_3D) then
+        ! We have inertiedatold
+       if((imold.ne.iim).or.(jmold.ne.jjm)) then
+       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
+     &of thermal inertia; might be better to reset it.'
+       write(*,*)
+       endif
+       
+        ! Do horizontal interpolation
+	if (depthinterpol) then
+	  call interp_horiz(inertiedatoldnew,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+	else
+          call interp_horiz(inertiedatold,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilold,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+        endif ! of if (depthinterpol)
+
+      else ! no 3D thermal inertia data
+       write(*,*)'lect_start_archive: using reference surface inertia'
+        ! Use surface inertia (and extend it to all depths)
+        do i=1,nsoilmx
+         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
+        enddo
+	! Build an old resolution surface thermal inertia
+	! (will be needed for tsoil interpolation)
+	call interp_horiz(surfith,surfithold,
+     &                    iim,jjm,imold,jmold,1,
+     &                    rlonu,rlatv,rlonuold,rlatvold)
+      endif
+
+
+      ! Reshape inertiedatS to scalar grid as inertiedat
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
+     &                  inertiedatS,inertiedat)
+      
+c-----------------------------------------------------------------------
+c 6.2.2 Soil temperature
+c-----------------------------------------------------------------------
+!      write(*,*) 'Soil'
+
+      !print*,'Problem in lect_start_archive interpolating'
+      !print*,'to new resolution!!'
+
+      ! Recast temperatures along soil depth, if necessary
+      if (olddepthdef) then
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        do i=1,imold+1
+	 do j=1,jmold+1
+
+            !if(i.gt.iip1 .or. j.gt.jjp1)then
+               !print*,'Problem in lect_start_archive interpolating'
+               !print*,'to new resolution!!'
+               !call abort
+            !endif
+
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+!	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	   ! build vertical coordinate
+	   oldgrid(1)=0. ! ground
+	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
+     &                (surfithold(i,j)/1.e6)
+          ! Note; at this stage, we impose volcapa=1.e6 above
+	  ! since volcapa isn't set in old soil definitions
+
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+
+      else
+       if (depthinterpol) then ! if vertical interpolation is required
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        ! build vertical coordinate
+	oldgrid(1)=0. ! ground
+	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+!	   oldval(1)=tsurfS(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+       
+       else
+        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
+       endif ! of if (depthinterpol)
+      endif ! of if (olddepthdef)
+
+      ! Do the horizontal interpolation
+       call interp_horiz(tsoiloldnew,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+      ! Reshape tsoilS to scalar grid as tsoil
+       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
+
+c-----------------------------------------------------------------------
+c 6.3   Slab Ocean :
+c-----------------------------------------------------------------------
+      call interp_horiz (tslabold,tslabs,imold,jmold,iim,jjm,noceanmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tslabs,tslab)
+
+      call interp_horiz (rnatold,rnats,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,rnats,rnat)
+
+      call interp_horiz (pctsrf_sicold,pctsrf_sics,imold,jmold,iim,
+     &                   jjm,1,rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,pctsrf_sics,pctsrf_sic)
+
+      call interp_horiz (tsea_iceold,tsea_ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tsea_ices,tsea_ice)
+
+      call interp_horiz (sea_iceold,sea_ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,sea_ices,sea_ice)
+
+c-----------------------------------------------------------------------
+c 6.4 Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
+      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,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 (*,*) 'lect_start_archive: 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)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'lect_start_archive: 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)
+c           vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+      if (nqtot .gt. 0) then
+c traceurs surface
+      do iq = 1, nqtot
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqtot
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+c      iqmax=1
+c      
+c      if (nqold.gt.10) then
+c       do l=1,llm
+c        do j=1,jjp1
+c          do i=1,iip1
+c           do iq=1,nqold
+c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+c              iqmax=iq
+c            endif
+c           enddo
+c           q(i,j,l,iqmax)=1.
+c           qtot(i,j,l)=0
+c           do iq=1,nqold
+c            if (iq.ne.iqmax) then        
+c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+c            endif
+c           enddo !iq
+c           do iq=1,nqold
+c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+c           enddo !iq
+c          enddo !i   
+c         enddo !j   
+c       enddo !l  
+c      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqtot
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+!      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
+! no need to transfer "co2ice" any more; it is in qsurf(igcm_co2_ice)
+
+      endif !! if nqtot .ne. 0
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(tsoiloldnew)
+      deallocate(inertiedatold)
+      deallocate(inertiedatoldnew)
+      deallocate(surfithold)
+      deallocate(mlayerold)
+      deallocate(qsurfold)
+      deallocate(var,varp1)
+      deallocate(tslabold)
+      deallocate(rnatold)
+      deallocate(pctsrf_sicold)
+      deallocate(tsea_iceold)
+      deallocate(sea_iceold)
+
+!      write(*,*)'lect_start_archive: END'
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/newstart.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/newstart.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/newstart.F	(revision 1403)
@@ -0,0 +1,1668 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      USE tracer_h, ONLY: igcm_co2_ice, igcm_h2o_vap, igcm_h2o_ice
+      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, inertiedat
+      USE surfdat_h, ONLY: phisfi, albedodat,
+     &                     zmea, zstd, zsig, zgam, zthe
+      USE comgeomfi_h, ONLY: lati, long, area
+      use datafile_mod, only: datadir
+! to use  'getin'
+!      USE ioipsl_getincom, only: getin
+      USE ioipsl_getincom_p, only: getin_p
+      use control_mod, only: day_step, iphysiq, anneeref
+      use phyredem, only: physdem0, physdem1
+      use iostart, only: open_startphy
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only:noceanmx
+      use filtreg_mod, only: inifilr
+      implicit none
+
+#include "dimensions.h"
+!#include "dimphys.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+!#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+#include "logic.h"
+#include "ener.h"
+#include "temps.h"
+#include "comdissnew.h"
+#include "serre.h"
+#include "netcdf.inc"
+!#include "advtrac.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER   NB_ETATMAX
+      parameter (NB_ETATMAX = 100)
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tsurf(ngridmx)	! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+!      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL emis(ngridmx)	! surface emissivity
+      real emisread             ! added by RW
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL q2(ngridmx,llm+1)
+!      REAL rnaturfi(ngridmx)
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      integer ierr 
+
+      REAL rnat(ngridmx)
+      REAL tslab(ngridmx,nsoilmx) ! slab ocean temperature
+      REAL pctsrf_sic(ngridmx) ! sea ice cover
+      REAL tsea_ice(ngridmx) ! temperature sea_ice
+      REAL sea_ice(ngridmx) ! mass of sea ice (kg/m2)
+
+c Variables on the new grid along scalar points 
+c------------------------------------------------------
+!      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      REAL tset(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+!      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1,pp
+      character*80      fichnom
+      character*250  filestring
+      integer Lmodif,iq,thermo
+      character modif*20
+      real z_reel(iip1,jjp1)
+      real tsud,albsud,alb_bb,ith_bb,Tiso,Tabove
+      real ptoto,pcap,patm,airetot,ptotn,patmn,psea
+!      real ssum
+      character*1 yes
+      logical :: flagtset=.false. ,  flagps0=.false.
+      real val, val2, val3, val4 ! to store temporary variables
+      real :: iceith=2000 ! thermal inertia of subterranean ice
+      integer iref,jref
+
+      INTEGER :: itau
+      
+      INTEGER :: nq,numvanle
+      character(len=20) :: txt ! to store some text
+      character(len=50) :: surfacefile ! "surface.nc" (or equivalent file)
+      character(len=150) :: longline
+      integer :: count
+      real :: profile(llm+1) ! to store an atmospheric profile + surface value
+
+!     added by RW for test
+      real pmean, phi0
+
+!     added by BC for equilibrium temperature startup
+      real teque
+
+!     added by BC for cloud fraction setup
+      REAL hice(ngridmx),cloudfrac(ngridmx,llm)
+      REAL totalfrac(ngridmx)
+
+
+!     added by RW for nuketharsis
+      real fact1
+      real fact2
+
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+!      INTEGER :: visuid
+!      real :: time_step,t_ops,t_wrt
+!      CHARACTER*80 :: visu_file
+
+      cpp    = 0.
+      preff  = 0.
+      pa     = 0. ! to ensure disaster rather than minor error if we don`t
+                  ! make deliberate choice of these values elsewhere.
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+! allocate arrays
+      allocate(q(iip1,jjp1,llm,nqtot))
+      allocate(qsurf(ngridmx,nqtot))
+
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+! Initialize global tracer indexes (stored in tracer.h)
+! ... this has to be done before phyetat0
+      call initracer(ngridmx,nqtot,tname)
+
+! Take care of arrays in common modules
+      ! ALLOCATE ARRAYS in surfdat_h (if not already done, e.g. when using start_archive)
+      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngridmx))
+      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngridmx))
+      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngridmx))
+      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngridmx))
+      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngridmx))
+      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngridmx))
+      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngridmx))
+      ! ALLOCATE ARRAYS in comsoil_h (if not already done)
+      IF (.not.ALLOCATED(layer))
+     . ALLOCATE(layer(nsoilmx))
+      IF (.not.ALLOCATED(mlayer))
+     . ALLOCATE(mlayer(0:nsoilmx-1))
+      IF (.not.ALLOCATED(inertiedat))
+     . ALLOCATE(inertiedat(ngridmx,nsoilmx))
+      ! ALLOCATE ARRAYS IN comgeomfi_h (done in inifis usually)
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+
+        write(*,*) 'reading 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
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'reading tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'reading tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+        write(*,*) 'printing tab_cntrl', tab_cntrl
+        do i=1,100
+          write(*,*) i,tab_cntrl(i)
+        enddo
+	
+        ! Lmodif set to 0 to disable modifications possibility in phyeta0                           
+        write(*,*) 'Reading file START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'Reading file STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (ngridmx,llm,fichnom,tab0,Lmodif,nsoilmx,
+     .        nqtot,day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,   !) ! temporary modif by RDW
+     .        cloudfrac,totalfrac,hice,rnat,pctsrf_sic,tslab,tsea_ice,
+     .        sea_ice)
+
+        ! copy albedo and soil thermal inertia on (local) physics grid
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+	  do j=1,nsoilmx
+           ithfi(i,j) = inertiedat(i,j)
+	  enddo
+        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
+        ! be needed later on if reinitializing soil thermal inertia
+          surfithfi(i)=ithfi(i,1)
+        enddo
+        ! also copy albedo and soil thermal inertia on (local) dynamics grid
+        ! so that options below can manipulate either (but must then ensure
+        ! to correctly recast things on physics grid)
+        call gr_fi_dyn(1,ngridmx,iip1,jjp1,albfi,alb)
+        call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+        call gr_fi_dyn(1,ngridmx,iip1,jjp1,surfithfi,surfith)
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+      ! for vertical coordinate
+      preff=tab_cntrl(18) ! reference surface pressure
+      pa=tab_cntrl(17)  ! reference pressure at which coord is purely pressure
+      !NB: in start_archive files tab_cntrl(17)=tab_cntrl(18)=0
+      write(*,*) "Newstart: preff=",preff," pa=",pa
+      yes=' '
+      do while ((yes.ne.'y').and.(yes.ne.'n'))
+        write(*,*) "Change the values of preff and pa? (y/n)"
+        read(*,fmt='(a)') yes
+      end do
+      if (yes.eq.'y') then
+        write(*,*)"New value of reference surface pressure preff?"
+        write(*,*)"   (for Mars, typically preff=610)"
+        read(*,*) preff
+        write(*,*)"New value of reference pressure pa for purely"
+        write(*,*)"pressure levels (for hybrid coordinates)?"
+        write(*,*)"   (for Mars, typically pa=20)"
+        read(*,*) pa
+      endif
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         ! tabfi requires that input file be first opened by open_startphy(fichnom)
+         fichnom = 'start_archive.nc'
+         call open_startphy(fichnom)
+         call tabfi (ngridmx,nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         fichnom = 'startfi.nc'
+         call open_startphy(fichnom)
+         Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+         call tabfi (ngridmx,nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
+      endif
+
+      if (p_omeg .eq. -9999.) then
+        p_omeg = 8.*atan(1.)/p_daysec
+        print*,"new value of omega",p_omeg
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      cpp = p_cpp
+      mugaz = p_mugaz
+      daysec = p_daysec
+
+      if (p_omeg .eq. -9999.) then
+        p_omeg = 8.*atan(1.)/p_daysec
+        print*,"new value of omega",p_omeg
+      endif
+
+      kappa = 8.314*1000./(p_mugaz*p_cpp) ! added by RDW
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+! Load parameters from run.def file
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
+!       rlatu() and rlonv() are given in radians
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+       
+      ! build airefi(), mesh area on physics grid
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+      ! Poles are single points on physics grid
+      airefi(1)=sum(aire(1:iim,1))
+      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
+
+! also initialize various physics flags/settings which might be needed
+!    (for instance initracer needs to know about some flags, and/or
+!      'datafile' path may be changed by user)
+      call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
+     &                latfi,lonfi,airefi,rad,g,r,cpp)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.eq.0) then  ! for start_archive files, 
+                              ! where an external "surface.nc" file is needed
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+!    First get the correct value of datadir, if not already done:
+        ! default 'datadir' is set in "datafile_mod"
+        call getin_p("datadir",datadir)
+        write(*,*) 'Available surface data files are:'
+        filestring='ls '//trim(datadir)//' | grep .nc'
+        call system(filestring)
+
+        write(*,*) ''
+        write(*,*) 'Please choose the relevant file',
+     &  ' (e.g. "surface_mars.nc")'
+        write(*,*) ' or "none" to not use any (and set planetary'
+        write(*,*) '  albedo and surface thermal inertia)'
+        read(*,fmt='(a50)') surfacefile
+
+        if (surfacefile.ne."none") then
+
+          CALL datareadnc(relief,surfacefile,phis,alb,surfith,
+     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
+        else
+        ! specific case when not using a "surface.nc" file
+          phis(:,:)=0
+          zmeaS(:,:)=0
+          zstdS(:,:)=0
+          zsigS(:,:)=0
+          zgamS(:,:)=0
+          ztheS(:,:)=0
+          
+          write(*,*) "Enter value of albedo of the bare ground:"
+          read(*,*) alb(1,1)
+          alb(:,:)=alb(1,1)
+          
+          write(*,*) "Enter value of thermal inertia of soil:"
+          read(*,*) surfith(1,1)
+          surfith(:,:)=surfith(1,1)
+        
+        endif ! of if (surfacefile.ne."none")
+
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif ! of if (choix_1.eq.0)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Reading file START_ARCHIVE'
+        CALL lect_start_archive(ngridmx,llm,
+     &   date,tsurf,tsoil,emis,q2,
+     &   t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf,
+     &   surfith,nid,
+     &   rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+        write(*,*) "OK, read start_archive file"
+	! copy soil thermal inertia
+	ithfi(:,:)=inertiedat(:,:)
+	
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then 
+         !do nothing, start and startfi have already been read
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/FLOAT(day_step)
+      dtphys   = dtvr * FLOAT(iphysiq)
+
+c=======================================================================
+c 
+c=======================================================================
+
+      do ! infinite loop on list of changes
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'List of possible changes :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat : no topography ("aquaplanet")'
+      write(*,*) 'set_ps_to_preff : used if changing preff with topo'
+      write(*,*) 'nuketharsis : no Tharsis bulge'
+      write(*,*) 'bilball : uniform albedo and thermal inertia'
+      write(*,*) 'coldspole : cold subsurface and high albedo at S.pole'
+      write(*,*) 'qname : change tracer name'
+      write(*,*) 't=profile  : read temperature profile in profile.in'
+      write(*,*) 'q=0 : ALL tracer =zero'
+      write(*,*) 'q=x : give a specific uniform value to one tracer'
+      write(*,*) 'q=profile    : specify a profile for a tracer'
+!      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
+!     $d ice   '
+!      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
+!     $ice '
+!      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
+!     $ly '
+      write(*,*) 'noglacier : Remove tropical H2O ice if |lat|<45'
+      write(*,*) 'watercapn : H20 ice on permanent N polar cap '
+      write(*,*) 'watercaps : H20 ice on permanent S polar cap '
+      write(*,*) 'noacglac  : H2O ice across Noachis Terra'
+      write(*,*) 'oborealis : H2O ice across Vastitas Borealis'
+      write(*,*) 'iceball   : Thick ice layer all over surface'
+      write(*,*) 'supercontinent: Create a continent of given Ab and TI'
+      write(*,*) 'wetstart  : start with a wet atmosphere'
+      write(*,*) 'isotherm  : Isothermal Temperatures, wind set to zero'
+      write(*,*) 'radequi   : Earth-like radiative equilibrium temperature
+     $ profile (lat-alt) and winds set to zero'
+      write(*,*) 'coldstart : Start X K above the CO2 frost point and 
+     $set wind to zero (assumes 100% CO2)'
+      write(*,*) 'co2ice=0 : remove CO2 polar cap'
+      write(*,*) 'ptot : change total pressure'
+      write(*,*) 'emis : change surface emissivity'
+      write(*,*) 'therm_ini_s : Set soil thermal inertia to reference sur
+     &face values'
+      write(*,*) 'slab_ocean_0 : initialisation of slab 
+     $ocean variables'
+
+        write(*,*)
+        write(*,*) 'Change to perform ?'
+        write(*,*) '   (enter keyword or return to end)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ')then
+         exit ! exit loop on changes
+        endif
+
+        write(*,*)
+        write(*,*) trim(modif) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (trim(modif) .eq. 'flat') then
+c         set topo to zero 
+          z_reel(1:iip1,1:jjp1)=0
+          phis(1:iip1,1:jjp1)=g*z_reel(1:iip1,1:jjp1)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+
+c        Choice of surface pressure
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to choose homogeneous surface',
+     &                 'pressure (y) or let newstart interpolate ',
+     &                 ' the previous field  (n)?'
+             read(*,fmt='(a)') yes
+         end do
+         if (yes.eq.'y') then
+           flagps0=.true.
+           write(*,*) 'New value for ps (Pa) ?'
+ 201       read(*,*,iostat=ierr) patm
+            if(ierr.ne.0) goto 201
+            write(*,*) patm
+            if (patm.eq.-9999.) then
+              patm = preff
+              write(*,*) "we set patm = preff", preff
+            endif
+             write(*,*)
+             write(*,*) ' new ps everywhere (Pa) = ', patm
+             write(*,*)
+             do j=1,jjp1
+               do i=1,iip1
+                 ps(i,j)=patm
+               enddo
+             enddo
+         end if
+
+c       'set_ps_to_preff' : used if changing preff with topo  
+c       ----------------------------------------------------
+        else if (trim(modif) .eq. 'set_ps_to_preff') then
+          do j=1,jjp1
+           do i=1,iip1
+             ps(i,j)=preff
+           enddo
+          enddo
+
+c       'nuketharsis : no tharsis bulge for Early Mars'
+c       ---------------------------------------------
+        else if (trim(modif) .eq. 'nuketharsis') then
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 fact1=(((rlonv(i)*180./pi)+100)**2 + 
+     &                (rlatu(j)*180./pi)**2)/65**2 
+                 fact2=exp( -fact1**2.5 )
+
+                 phis(i,j) = phis(i,j) - (phis(i,j)+4000.*g)*fact2
+
+!                 if(phis(i,j).gt.2500.*g)then
+!                    if(rlatu(j)*180./pi.gt.-80.)then ! avoid chopping south polar cap
+!                       phis(i,j)=2500.*g
+!                    endif
+!                 endif
+
+              ENDDO
+           ENDDO
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+c       bilball : uniform albedo, thermal inertia
+c       -----------------------------------------
+        else if (trim(modif) .eq. 'bilball') then
+          write(*,*) 'constante albedo and iner.therm:'
+          write(*,*) 'New value for albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' uniform albedo (new value):',alb_bb
+          write(*,*)
+
+          write(*,*) 'New value for thermal inertia (eg: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'uniform thermal inertia (new value):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb	! albedo
+		do isoil=1,nsoilmx
+                  ith(i,j,isoil) = ith_bb	! thermal inertia
+		enddo
+             END DO
+          END DO
+!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (trim(modif) .eq. 'coldspole') then
+          write(*,*)'new value for the subsurface temperature',
+     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' new value of the subsurface temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'new value for the albedo',
+     &   'of the permanent southern polar cap ? (eg: 0.75)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  only the albedo of the pole is modified :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification of the total pressure: ice + current atmosphere 
+c       -------------------------------------------------------------------
+        else if (trim(modif).eq.'ptot') then
+
+          ! check if we have a co2_ice surface tracer:
+          if (igcm_co2_ice.eq.0) then
+            write(*,*) " No surface CO2 ice !"
+            write(*,*) " only atmospheric pressure will be considered!"
+          endif
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                if (igcm_co2_ice.ne.0) then
+                  !pcap = pcap + aire(i,j)*co2ice(ig)*g
+                  pcap = pcap + aire(i,j)*qsurf(ig,igcm_co2_ice)*g
+                endif
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Current total pressure at surface (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'new value?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Mult. factor for pressure (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c        Correction pour la pression au niveau de la mer
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish fix pressure at sea level (y)',
+     &              ' or not (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'Value?'
+		read(*,*,iostat=ierr) psea
+             DO i=1,iip1
+               DO j=1,jjp1
+                    ps(i,j)=psea
+
+                  ENDDO
+               ENDDO
+		write(*,*) 'psea=',psea
+          else
+            write(*,*) 'no'
+          end if
+
+
+c       emis : change surface emissivity (added by RW)
+c       ----------------------------------------------
+        else if (trim(modif).eq.'emis') then
+
+           print*,'new value?'
+           read(*,*) emisread
+
+           do i=1,ngridmx
+              emis(i)=emisread
+           enddo
+
+c       qname : change tracer name
+c       --------------------------
+        else if (trim(modif).eq.'qname') then
+         yes='y'
+         do while (yes.eq.'y')
+          write(*,*) 'Which tracer name do you want to change ?'
+          do iq=1,nqtot
+            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
+          enddo
+          write(*,'(a35,i3)')
+     &            '(enter tracer number; between 1 and ',nqtot
+          write(*,*)' or any other value to quit this option)'
+          read(*,*) iq
+          if ((iq.ge.1).and.(iq.le.nqtot)) then
+            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
+            read(*,*) txt
+            tname(iq)=txt
+            write(*,*)'Do you want to change another tracer name (y/n)?'
+            read(*,'(a)') yes 
+          else
+! inapropiate value of iq; quit this option
+            yes='n'
+          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
+         enddo ! of do while (yes.ne.'y')
+
+c       q=0 : set tracers to zero
+c       -------------------------
+        else if (trim(modif).eq.'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          set surface tracers to zero
+           DO iq =1, nqtot
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (trim(modif).eq.'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
+     &                 ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
+     &                   ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       t=profile : initialize temperature with a given profile
+c       -------------------------------------------------------
+        else if (trim(modif) .eq. 't=profile') then
+             write(*,*) 'Temperature profile from ASCII file'
+             write(*,*) "'profile.in' e.g. 1D output"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             txt="profile.in"
+             open(33,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(33,*,iostat=ierr) profile(l)
+                 write(*,*) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 tsurf(1:ngridmx)=profile(1)
+                 tsoil(1:ngridmx,1:nsoilmx)=profile(1)
+                 do l=1,llm
+                   Tset(1:iip1,1:jjp1,l)=profile(l+1)
+                   flagtset=.true.
+                 enddo
+                 ucov(1:iip1,1:jjp1,1:llm)=0.
+                 vcov(1:iip1,1:jjm,1:llm)=0.
+                 q2(1:ngridmx,1:llm+1)=0.
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to temperature'
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to temperature'
+             endif
+
+c       q=profile : initialize tracer with a given profile
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'q=profile') then
+             write(*,*) 'Tracer profile will be sought in ASCII file'
+             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             write(*,*) 'Which tracer do you want to set?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             ! look for input file 'profile_tracer'
+             txt="profile_"//trim(tname(iq))
+             open(41,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(41,*,iostat=ierr) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 ! initialize tracer values
+                 qsurf(:,iq)=profile(1)
+                 do l=1,llm
+                   q(:,:,l,iq)=profile(l+1)
+                 enddo
+                 write(*,*)'OK, tracer ',trim(tname(iq)),' initialized '
+     &                    ,'using values from file ',trim(txt)
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to tracer ',trim(tname(iq))
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to tracer ',trim(tname(iq))
+             endif
+             
+
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'wetstart') then
+        ! check that there is indeed a water vapor tracer
+        if (igcm_h2o_vap.eq.0) then
+          write(*,*) "No water vapour tracer! Can't use this option"
+          stop
+        endif
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1
+                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,igcm_h2o_vap)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,igcm_h2o_vap)
+
+c      noglacier : remove tropical water ice (to initialize high res sim)
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'noglacier') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              write(*,*) 'OK: remove surface ice for |lat|<45'
+              if (abs(rlatu(j)*180./pi).lt.45.) then
+                   qsurf(ig,igcm_h2o_ice)=0.
+              end if
+           end do
+
+
+c      watercapn : H20 ice on permanent northern cap
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'watercapn') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 if (rlatu(j)*180./pi.gt.80.) then
+                    qsurf(ig,igcm_h2o_ice)=3.4e3
+                    !do isoil=1,nsoilmx
+                    !   ith(i,j,isoil) = 18000. ! thermal inertia
+                    !enddo
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &                   rlatv(j-1)*180./pi
+                 end if
+              ENDDO
+           ENDDO
+           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c$$$           do ig=1,ngridmx
+c$$$             j=(ig-2)/iim +2
+c$$$              if(ig.eq.1) j=1
+c$$$              if (rlatu(j)*180./pi.gt.80.) then
+c$$$
+c$$$                   qsurf(ig,igcm_h2o_ice)=1.e5
+c$$$                   qsurf(ig,igcm_h2o_vap)=0.0!1.e5
+c$$$
+c$$$                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+c$$$     &              qsurf(ig,igcm_h2o_ice)
+c$$$
+c$$$                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+c$$$     &              rlatv(j)*180./pi
+c$$$                end if
+c$$$           enddo
+
+c      watercaps : H20 ice on permanent southern cap
+c      -------------------------------------------------
+        else if (trim(modif) .eq. 'watercaps') then
+           if (igcm_h2o_ice.eq.0) then
+              write(*,*) "No water ice tracer! Can't use this option"
+              stop
+           endif
+
+           DO j=1,jjp1        
+              DO i=1,iim
+                 ig=1+(j-2)*iim +i
+                 if(j.eq.1) ig=1
+                 if(j.eq.jjp1) ig=ngridmx
+
+                 if (rlatu(j)*180./pi.lt.-80.) then
+                    qsurf(ig,igcm_h2o_ice)=3.4e3
+                    !do isoil=1,nsoilmx
+                    !   ith(i,j,isoil) = 18000. ! thermal inertia
+                    !enddo
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &                   rlatv(j-1)*180./pi
+                 end if
+              ENDDO
+           ENDDO
+           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c$$$           do ig=1,ngridmx
+c$$$               j=(ig-2)/iim +2
+c$$$               if(ig.eq.1) j=1
+c$$$               if (rlatu(j)*180./pi.lt.-80.) then
+c$$$                  qsurf(ig,igcm_h2o_ice)=1.e5
+c$$$                  qsurf(ig,igcm_h2o_vap)=0.0 !1.e5
+c$$$
+c$$$                  write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+c$$$     &                 qsurf(ig,igcm_h2o_ice)
+c$$$                  write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+c$$$     &                 rlatv(j-1)*180./pi
+c$$$               end if
+c$$$           enddo
+
+
+c       noacglac : H2O ice across highest terrain
+c       --------------------------------------------
+        else if (trim(modif) .eq. 'noacglac') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).gt.1000.*g)then
+                    alb(i,j) = 0.5 ! snow value
+                    do isoil=1,nsoilmx
+                       ith(i,j,isoil) = 18000. ! thermal inertia
+                       ! this leads to rnat set to 'ocean' in physiq.F90
+                       ! actually no, because it is soil not surface
+                    enddo
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+
+c       oborealis : H2O oceans across Vastitas Borealis
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'oborealis') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).lt.-4000.*g)then
+!                if( (phis(i,j).lt.-4000.*g)
+!     &               .and. (rlatu(j)*180./pi.lt.0.) )then ! south hemisphere only
+!                    phis(i,j)=-8000.0*g ! proper ocean
+                    phis(i,j)=-4000.0*g ! scanty ocean
+
+                    alb(i,j) = 0.07 ! oceanic value
+                    do isoil=1,nsoilmx
+                       ith(i,j,isoil) = 18000. ! thermal inertia
+                       ! this leads to rnat set to 'ocean' in physiq.F90
+                       ! actually no, because it is soil not surface
+                    enddo
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+c       iborealis : H2O ice in Northern plains
+c       --------------------------------------
+        else if (trim(modif) .eq. 'iborealis') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                if(phis(i,j).lt.-4000.*g)then
+                   !qsurf(ig,igcm_h2o_ice)=1.e3
+                   qsurf(ig,igcm_h2o_ice)=241.4 ! to make total 33 kg m^-2
+                endif
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+
+c       oceanball : H2O liquid everywhere
+c       ----------------------------
+        else if (trim(modif) .eq. 'oceanball') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                qsurf(ig,igcm_h2o_vap)=0.0    ! for ocean, this is infinite source
+                qsurf(ig,igcm_h2o_ice)=0.0
+                alb(i,j) = 0.07 ! ocean value
+
+                do isoil=1,nsoilmx
+                   ith(i,j,isoil) = 18000. ! thermal inertia
+                   !ith(i,j,isoil) = 50. ! extremely low for test
+                   ! this leads to rnat set to 'ocean' in physiq.F90
+                enddo
+
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+
+c       iceball : H2O ice everywhere
+c       ----------------------------
+        else if (trim(modif) .eq. 'iceball') then
+           if (igcm_h2o_ice.eq.0) then
+             write(*,*) "No water ice tracer! Can't use this option"
+             stop
+           endif
+          DO j=1,jjp1        
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+
+                qsurf(ig,igcm_h2o_vap)=-50.    ! for ocean, this is infinite source
+                qsurf(ig,igcm_h2o_ice)=50.     ! == to 0.05 m of oceanic ice
+                alb(i,j) = 0.6 ! ice albedo value
+
+                do isoil=1,nsoilmx
+                   !ith(i,j,isoil) = 18000. ! thermal inertia
+                   ! this leads to rnat set to 'ocean' in physiq.F90
+                enddo
+
+             ENDDO
+          ENDDO
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       supercontinent : H2O ice everywhere
+c       ----------------------------
+        else if (trim(modif) .eq. 'supercontinent') then
+          write(*,*) 'Minimum longitude (-180,180)'
+          read(*,*) val
+          write(*,*) 'Maximum longitude (-180,180)'
+          read(*,*) val2
+          write(*,*) 'Minimum latitude (-90,90)'
+          read(*,*) val3
+          write(*,*) 'Maximum latitude (-90,90)'
+          read(*,*) val4
+
+          do j=1,jjp1
+            do i=1,iip1
+              ig=1+(j-2)*iim +i
+              if(j.eq.1) ig=1
+              if(j.eq.jjp1) ig=ngridmx
+
+c             Supercontinent:
+              if (((rlatu(j)*180./pi.le.val4).and.
+     &            (rlatu(j)*180./pi.ge.val3).and.
+     &            (rlonv(i)*180./pi.le.val2).and.
+     &            (rlonv(i)*180./pi.ge.val))) then
+
+                rnat(ig)=1.
+                alb(i,j) = 0.3
+                do isoil=1,nsoilmx
+                  ith(i,j,isoil) = 2000.
+                enddo
+c             Ocean:
+              else
+                rnat(ig)=0.
+                alb(i,j) = 0.07
+                do isoil=1,nsoilmx
+                  ith(i,j,isoil) = 18000.
+                enddo
+              end if
+
+            enddo
+          enddo
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+c       isotherm : Isothermal temperatures and no winds
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of this temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          tsurf(1:ngridmx)=Tiso
+          
+          tsoil(1:ngridmx,1:nsoilmx)=Tiso
+          
+          Tset(1:iip1,1:jjp1,1:llm)=Tiso
+          flagtset=.true.
+
+          t(1:iip1,1:jjp1,1:llm)=Tiso
+          !! otherwise hydrost. integrations below
+          !! use the wrong temperature
+          !! -- NB: Tset might be useless
+        
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:llm+1)=0
+
+c       radequi : Radiative equilibrium profile of temperatures and no winds
+c       --------------------------------------------------------------------
+        else if (trim(modif) .eq. 'radequi') then
+
+          write(*,*)'radiative equilibrium temperature profile'       
+
+          do ig=1, ngridmx
+             teque= 335.0-60.0*sin(latfi(ig))*sin(latfi(ig))-
+     &            10.0*cos(latfi(ig))*cos(latfi(ig))
+             tsurf(ig) = MAX(220.0,teque)
+          end do
+          do l=2,nsoilmx
+             do ig=1, ngridmx
+                tsoil(ig,l) = tsurf(ig)
+             end do
+          end do
+          DO j=1,jjp1
+             DO i=1,iim
+                Do l=1,llm
+                   teque=335.-60.0*sin(rlatu(j))*sin(rlatu(j))-
+     &                  10.0*cos(rlatu(j))*cos(rlatu(j))
+                   Tset(i,j,l)=MAX(220.0,teque)
+                end do
+             end do
+          end do
+          flagtset=.true.
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:llm+1)=0
+
+c       coldstart : T set 1K above CO2 frost point and no winds
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'coldstart') then
+
+          write(*,*)'set temperature of the atmosphere,' 
+     &,'surface and subsurface how many degrees above CO2 frost point?'
+ 204      read(*,*,iostat=ierr) Tabove
+          if(ierr.ne.0) goto 204
+
+            DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+            tsurf(ig) = (-3167.8)/(log(.01*ps(i,j))-23.23)+Tabove
+             END DO
+            END DO
+          do l=1,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = tsurf(ig)
+            end do
+          end do
+          DO j=1,jjp1
+           DO i=1,iim
+            Do l=1,llm
+               pp = aps(l) +bps(l)*ps(i,j) 
+               Tset(i,j,l)=(-3167.8)/(log(.01*pp)-23.23)+Tabove
+            end do
+           end do
+          end do
+
+          flagtset=.true.
+          ucov(1:iip1,1:jjp1,1:llm)=0
+          vcov(1:iip1,1:jjm,1:llm)=0
+          q2(1:ngridmx,1:llm+1)=0
+
+
+c       co2ice=0 : remove CO2 polar ice caps'
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'co2ice=0') then
+         ! check that there is indeed a co2_ice tracer ...
+          if (igcm_co2_ice.ne.0) then
+           do ig=1,ngridmx
+              !co2ice(ig)=0
+              qsurf(ig,igcm_co2_ice)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+          else
+            write(*,*) "Can't remove CO2 ice!! (no co2_ice tracer)"
+          endif
+        
+!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
+!       ----------------------------------------------------------------------
+
+	else if (trim(modif) .eq. 'therm_ini_s') then
+!          write(*,*)"surfithfi(1):",surfithfi(1)
+	  do isoil=1,nsoilmx
+	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+	  enddo
+          write(*,*)'OK: Soil thermal inertia has been reset to referenc
+     &e surface values'
+!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
+	  ithfi(:,:)=inertiedat(:,:)
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+
+
+c       slab_ocean_initialisation
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'slab_ocean_0') then
+        write(*,*)'OK: initialisation of slab ocean' 
+
+      DO ig=1, ngridmx
+         rnat(ig)=1.
+         tslab(ig,1)=0.
+         tslab(ig,2)=0.
+         tsea_ice(ig)=0.
+         sea_ice(ig)=0.
+         pctsrf_sic(ig)=0.
+         
+         if(ithfi(ig,1).GT.10000.)then
+           rnat(ig)=0.
+           phisfi(ig)=0.
+           tsea_ice(ig)=273.15-1.8
+           tslab(ig,1)=tsurf(ig)
+           tslab(ig,2)=tsurf(ig)!*2./3.+(273.15-1.8)/3.
+          endif
+
+      ENDDO
+          CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,phisfi,phis)
+
+
+
+        else
+          write(*,*) '       Unknown (misspelled?) option!!!'
+        end if ! of if (trim(modif) .eq. '...') elseif ...
+
+
+
+       enddo ! of do ! infinite loop on liste of changes
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Initialisation for cloud fraction and oceanic ice (added by BC 2010)
+c=======================================================================
+      DO ig=1, ngridmx
+         totalfrac(ig)=0.5
+         DO l=1,llm
+            cloudfrac(ig,l)=0.5
+         ENDDO
+! Ehouarn, march 2012: also add some initialisation for hice
+         hice(ig)=0.0
+      ENDDO
+      
+c========================================================
+
+!      DO ig=1,ngridmx
+!         IF(tsurf(ig) .LT. 273.16-1.8) THEN
+!            hice(ig)=(273.16-1.8-tsurf(ig))/(273.16-1.8-240)*1.
+!            hice(ig)=min(hice(ig),1.0)
+!         ENDIF
+!      ENDDO
+
+
+
+
+c=======================================================================
+c   Correct pressure on the new grid (menu 0)
+c=======================================================================
+
+
+      if ((choix_1.eq.0).and.(.not.flagps0)) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) *
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+
+c periodicite de ps en longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+         
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagtset) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tset(i,j,l) * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+
+          
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
+      CALL dynredem1("restart.nc",0.0,vcov,ucov,teta,q,nqtot,masse,ps) 
+C
+C Ecriture etat initial physique
+C
+
+      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
+     &              nqtot,dtphys,real(day_ini),0.0,
+     &              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nq,
+     &                dtphys,real(day_ini),
+     &                tsurf,tsoil,emis,q2,qsurf,
+     &                cloudfrac,totalfrac,hice,
+     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      write(*,*) "newstart: All is well that ends well."
+
+      end
+
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/scal_wind.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/scal_wind.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/scal_wind.F	(revision 1403)
@@ -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.GENERIC/libf/dynlonlat_phylonlat/phystd/start2archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/start2archive.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/start2archive.F	(revision 1403)
@@ -0,0 +1,519 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      USE comsoil_h
+      USE comgeomfi_h, ONLY: lati, long, area
+!      use control_mod
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only: noceanmx
+! to use  'getin'
+      USE ioipsl_getincom
+      USE planete_mod, only: year_day
+      USE callkeys_mod, ONLY: ok_slab_ocean
+      use filtreg_mod, only: inifilr
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+!#include "control.h"
+#include "ener.h"
+
+!#include "dimphys.h"
+!#include "planete.h"
+!#include"advtrac.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 :: q(:,:,:)   ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL 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 ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL q2(ngridmx,llm+1)
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL emis(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
+
+!     added by FF for cloud fraction setup
+      REAL hice(ngridmx)
+      REAL cloudfrac(ngridmx,llm),totalcloudfrac(ngridmx)
+
+!     added by BC for slab ocean
+      REAL rnat(ngridmx),pctsrf_sic(ngridmx),sea_ice(ngridmx)
+      REAL tslab(ngridmx,noceanmx),tsea_ice(ngridmx)
+
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1)
+      REAL tsoilS(ip1jmp1,nsoilmx)
+      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
+      REAL co2iceS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1)
+      REAL,ALLOCATABLE :: qsurfS(:,:)
+      REAL emisS(ip1jmp1)
+
+!     added by FF for cloud fraction setup
+      REAL hiceS(ip1jmp1)
+      REAL cloudfracS(ip1jmp1,llm),totalcloudfracS(ip1jmp1)
+
+!     added by BC for slab ocean
+      REAL rnatS(ip1jmp1),pctsrf_sicS(ip1jmp1),sea_iceS(ip1jmp1)
+      REAL tslabS(ip1jmp1,noceanmx),tsea_iceS(ip1jmp1)
+
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+      integer :: nq,numvanle
+      character(len=30) :: txt ! to store some text
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .TRUE. )
+      grireg   = .TRUE.
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+      ! ALLOCATE ARRAYS IN comgeomfi_h (usually done in inifis)
+      ! this must be here for start2archive to work
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+
+! allocate arrays:
+      allocate(q(ip1jmp1,llm,nqtot))
+      allocate(qsurf(ngridmx,nqtot))
+      allocate(qsurfS(ip1jmp1,nqtot))
+! other array allocations:
+      call ini_comsoil_h(ngridmx)
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+! load 'controle' array from dynamics start file
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_dyn)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_dyn)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+      
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+
+      CALL phyetat0 (ngridmx,llm,fichnom,0,Lmodif,nsoilmx,nqtot,
+     .      day_ini_fi,timefi,
+     .      tsurf,tsoil,emis,q2,qsurf,
+!       change FF 05/2011
+     .       cloudfrac,totalcloudfrac,hice,
+!       change BC 05/2014
+     .       rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+
+
+
+! load 'controle' array from physics start file
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.year_day)
+          day_ini=day_ini-year_day
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+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-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+!      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      ! Note: thermal inertia "inertiedat" is in comsoil.h
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
+      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,cloudfrac,cloudfracS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,hice,hiceS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totalcloudfrac,totalcloudfracS)
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rnat,rnatS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,pctsrf_sic,pctsrf_sicS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsea_ice,tsea_iceS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sea_ice,sea_iceS)
+      call gr_fi_dyn(noceanmx,ngridmx,iip1,jjp1,tslab,tslabS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+!           co2icetotal = co2icetotal + 
+!     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+!      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+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 dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+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,day_ini,phis,ithS,tab_cntrl_fi,
+     &                                          tab_cntrl_dyn)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+!      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+!     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
+     &         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+        txt=trim(tname(iq))//"_surf"
+        call write_archive(nid,ntime,txt,'Tracer on surface',
+     &  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+c      do isoil=1,nsoilmx
+c       write(str2,'(i2.2)') isoil
+c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+c     .   'K',2,tsoilS(1,isoil))
+c      enddo
+
+! Write soil temperatures tsoil
+      call write_archive(nid,ntime,'tsoil','Soil temperature',
+     &     'K',-3,tsoilS)
+
+! Write soil thermal inertia
+      call write_archive(nid,ntime,'inertiedat',
+     &     'Soil thermal inertia',
+     &     'J.s-1/2.m-2.K-1',-3,ithS)
+
+! Write (0D) volumetric heat capacity (stored in comsoil.h)
+!      call write_archive(nid,ntime,'volcapa',
+!     &     'Soil volumetric heat capacity',
+!     &     'J.m-3.K-1',0,volcapa)
+! Note: no need to write volcapa, it is stored in "controle" table
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  cloudfrac,hice,totalcloudfrac
+c-----------------------------------------------------------------------
+      call write_archive(nid,ntime,'hice',
+     &         'Height of oceanic ice','m',2,hiceS)
+      call write_archive(nid,ntime,'totalcloudfrac',
+     &        'Total cloud Fraction','',2,totalcloudfracS)
+      call write_archive(nid,ntime,'cloudfrac'
+     &        ,'Cloud fraction','',3,cloudfracS)
+
+c-----------------------------------------------------------------------
+c Slab ocean
+c-----------------------------------------------------------------------
+      OPEN(99,file='callphys.def',status='old',form='formatted'
+     &     ,iostat=ierr)
+      CLOSE(99)
+
+      IF(ierr.EQ.0) THEN
+
+
+         write(*,*) "Use slab-ocean ?"
+         ok_slab_ocean=.false.         ! default value
+         call getin("ok_slab_ocean",ok_slab_ocean)
+         write(*,*) "ok_slab_ocean = ",ok_slab_ocean
+
+      if(ok_slab_ocean) then
+      call write_archive(nid,ntime,'rnat'
+     &        ,'rnat','',2,rnatS)
+      call write_archive(nid,ntime,'pctsrf_sic'
+     &        ,'pctsrf_sic','',2,pctsrf_sicS)
+      call write_archive(nid,ntime,'sea_ice'
+     &        ,'sea_ice','',2,sea_iceS)
+      call write_archive(nid,ntime,'tslab'
+     &        ,'tslab','',3,tslabS)
+      call write_archive(nid,ntime,'tsea_ice'
+     &        ,'tsea_ice','',2,tsea_iceS)
+      endif !ok_slab_ocean
+      ENDIF
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+      ierr=NF_CLOSE(nid)
+
+      write(*,*) "start2archive: All is well that ends well."
+
+      end 
Index: /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/wind_scal.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/wind_scal.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/wind_scal.F	(revision 1403)
@@ -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.GENERIC/libf/dynlonlat_phylonlat/phystd/write_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/write_archive.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/dynlonlat_phylonlat/phystd/write_archive.F	(revision 1403)
@@ -0,0 +1,250 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,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 comsoil_h, only: nsoilmx
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid
+      integer ntime ! time index
+      integer 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
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+! For an atmospheric 3D Variable
+!--------------------------------
+        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,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",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
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           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
+
+
+! For a subterranean 3D Variable
+!-------------------------------
+
+        else if (dim.eq.-3) then
+	! get variables' ID, if it exists
+	ierr=NF_INQ_VARID(nid,nom,varid)
+	
+	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
+	  ! build related coordinates
+	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
+	  if (ierr.ne.NF_NOERR) then
+	   write(*,*)"write_archive: dimension <subsurface_layers>",
+     &               " is missing !!!"
+	   call abort
+	  endif
+          ierr=NF_INQ_DIMID(nid,"Time",id(4))
+	  
+	  ! define the variable
+	  write(*,*)"====================="
+	  write(*,*)"defining ",nom
+	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+	  
+	 endif
+
+        ! build cedges and corners
+        corner(1)=1
+        corner(2)=1
+        corner(3)=1
+        corner(4)=ntime
+
+        edges(1)=iip1
+        edges(2)=jjp1
+        edges(3)=nsoilmx
+        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
+
+
+! For a surface 2D Variable
+!--------------------------
+
+        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,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",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,"Time",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
+
+        else
+	  write(*,*) "write_archive: dim=",dim," ?!?"
+	  call abort
+        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
+
+      return
+      end
+
Index: /trunk/LMDZ.GENERIC/libf/filtrez/coefils.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/filtrez/coefils.h	(revision 1402)
+++ /trunk/LMDZ.GENERIC/libf/filtrez/coefils.h	(revision 1403)
@@ -1,7 +1,7 @@
-      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
-     * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
-     * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
-     * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
-c
+      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
+     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
+     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
+     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
+!c
       INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
       REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
Index: /trunk/LMDZ.GENERIC/libf/filtrez/filtreg_mod.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/filtrez/filtreg_mod.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/filtrez/filtreg_mod.F90	(revision 1403)
@@ -0,0 +1,590 @@
+MODULE filtreg_mod
+
+CONTAINS
+
+      SUBROUTINE inifilr
+!
+!    ... H. Upadhyaya, O.Sharma   ...
+!
+      IMPLICIT NONE
+!
+!     version 3 .....
+
+!     Correction  le 28/10/97    P. Le Van .
+!  -------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+!  -------------------------------------------------------------------
+#include "comgeom.h"
+#include "coefils.h"
+#include "logic.h"
+#include "serre.h"
+
+      REAL  dlonu(iim),dlatu(jjm)
+      REAL  rlamda( iim ),  eignvl( iim )
+!
+
+      REAL    lamdamax,pi,cof
+      INTEGER i,j,modemax,imx,k,kf,ii
+      REAL dymin,dxmin,colat0
+      REAL eignft(iim,iim), coff
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs 
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus) &
+                   , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs) &
+                   ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+#ifdef CRAY
+      INTEGER   ISMIN
+      EXTERNAL  ISMIN
+      INTEGER iymin 
+      INTEGER ixmineq
+#endif
+      EXTERNAL  inifgn
+!
+! ------------------------------------------------------------
+!   This routine computes the eigenfunctions of the laplacien
+!   on the stretched grid, and the filtering coefficients
+!      
+!  We designate:
+!   eignfn   eigenfunctions of the discrete laplacien
+!   eigenvl  eigenvalues
+!   jfiltn   indexof the last scalar line filtered in NH
+!   jfilts   index of the first line filtered in SH
+!   modfrst  index of the mode from where modes are filtered
+!   modemax  maximum number of modes ( im )
+!   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
+!   sdd      SQRT( dx )
+!      
+!     the modes are filtered from modfrst to modemax
+      
+!-----------------------------------------------------------
+!
+
+       pi       = 2. * ASIN( 1. )
+
+       DO i = 1,iim
+        dlonu(i) = xprimu( i )
+       ENDDO
+!
+       CALL inifgn(eignvl)
+!
+        print *,' EIGNVL '
+        PRINT 250,eignvl
+250     FORMAT( 1x,5e13.6)
+!
+! compute eigenvalues and eigenfunctions
+!
+!
+!.................................................................
+!
+!  compute the filtering coefficients for scalar lines and 
+!  meridional wind v-lines
+!
+!  we filter all those latitude lines where coefil < 1
+!  NO FILTERING AT POLES
+!
+!  colat0 is to be used  when alpha (stretching coefficient)
+!  is set equal to zero for the regular grid case 
+!
+!    .......   Calcul  de  colat0   .........
+!     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
+!
+!
+      DO 45 j = 1,jjm
+         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
+ 45   CONTINUE
+!
+#ifdef CRAY
+      iymin   = ISMIN( jjm, dlatu, 1 )
+      ixmineq = ISMIN( iim, dlonu, 1 )
+      dymin   = dlatu( iymin )
+      dxmin   = dlonu( ixmineq )
+#else
+      dxmin   =  dlonu(1)
+       DO  i  = 2, iim
+        dxmin = MIN( dxmin,dlonu(i) )
+       ENDDO
+      dymin  = dlatu(1)
+       DO j  = 2, jjm
+        dymin = MIN( dymin,dlatu(j) )
+       ENDDO
+#endif
+!
+!
+      colat0  =  MIN( 0.5, dymin/dxmin )
+!
+      IF( .NOT.fxyhypb.AND.ysinus )  THEN
+           colat0 = 0.6
+!         ...... a revoir  pour  ysinus !   .......
+           alphax = 0.
+      ENDIF
+!
+      PRINT 50, colat0,alphax
+  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
+!
+      IF(alphax.EQ.1. )  THEN
+        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
+         STOP
+      ENDIF
+!
+      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
+
+!c                        ... Correction  le 28/10/97  ( P.Le Van ) ..
+!
+      DO 71 i = 2,iim
+       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
+ 71   CONTINUE
+!
+
+      DO 72 j = 1,jjm
+	    DO 73 i = 1,iim
+	    coefilu( i,j )  = 0.0
+	    coefilv( i,j )  = 0.0
+	    coefilu2( i,j ) = 0.0
+	    coefilv2( i,j ) = 0.0
+ 73     CONTINUE
+ 72   CONTINUE
+
+!
+!    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
+!    .........................................................
+!
+       modemax = iim
+
+!ccc    imx = modemax - 4 * (modemax/iim)
+
+       imx  = iim
+!
+       PRINT *,' TRUNCATION AT ',imx
+!
+      DO 75 j = 2, jjm/2+1
+       cof = COS( rlatu(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+        ENDIF
+
+       cof = COS( rlatu(jjp1-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) &
+            jfiltsu= jjp1-j+1
+        ENDIF
+ 75   CONTINUE
+!
+      DO 76 j = 1, jjm/2
+       cof = COS( rlatv(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+        ENDIF
+
+       cof = COS( rlatv(jjm-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) &
+             jfiltsv= jjm-j+1
+        ENDIF
+ 76   CONTINUE
+!                                 
+
+      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
+        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
+        STOP
+      ENDIF
+
+      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
+        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
+        STOP
+      ENDIF
+
+      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
+        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
+        STOP
+      ENDIF
+
+      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
+        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
+        STOP
+      ENDIF
+
+       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' , &
+                 jfiltnv,jfiltsv,jfiltnu,jfiltsu
+
+!                                 
+!   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
+!................................................................
+!
+!
+      DO 77 j = 1,jjm
+	  modfrstu( j ) = iim
+	  modfrstv( j ) = iim
+ 77   CONTINUE
+!
+      DO 84 j = 2,jfiltnu
+       DO 81 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 82
+ 81    CONTINUE
+      GOTO 84
+ 82   modfrstu( j ) = k
+!
+	  kf = modfrstu( j )
+	   DO 83 k = kf , modemax
+        cof = rlamda(k) * COS( rlatu(j) )
+	    coefilu(k,j) = cof - 1.
+	    coefilu2(k,j) = cof*cof - 1.
+ 83    CONTINUE
+ 84   CONTINUE
+!                                 
+!
+      DO 89 j = 1,jfiltnv
+!
+       DO 86 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 87
+ 86    CONTINUE
+      GOTO 89
+ 87   modfrstv( j ) = k
+!
+	   kf = modfrstv( j )
+	   DO 88 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 88    CONTINUE
+!
+ 89    CONTINUE
+!
+      DO 94 j = jfiltsu,jjm
+       DO 91 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 92
+ 91    CONTINUE
+      GOTO 94
+ 92   modfrstu( j ) = k
+!
+        kf = modfrstu( j )
+	 DO 93 k = kf , modemax
+          cof = rlamda(k) * COS( rlatu(j) )
+	  coefilu(k,j) = cof - 1.
+	  coefilu2(k,j) = cof*cof - 1.
+ 93      CONTINUE
+ 94    CONTINUE
+!                                 
+      DO 99 j = jfiltsv,jjm
+       DO 96 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 97
+ 96    CONTINUE
+      GOTO 99
+ 97   modfrstv( j ) = k
+!
+       kf = modfrstv( j )
+	   DO 98 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 98    CONTINUE
+ 99   CONTINUE
+!
+
+       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
+
+         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
+         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
+
+          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , &
+              jfiltnv,jfiltsv,jfiltnu,jfiltsu
+       ENDIF
+
+       PRINT *,'   Modes premiers  v  '
+       PRINT 334,modfrstv
+       PRINT *,'   Modes premiers  u  '
+       PRINT 334,modfrstu
+
+     
+      IF( nfilun.LT. jfiltnu )  THEN
+       PRINT *,' le parametre nfilun utilise pour la matrice ', &
+         ' matriceun  est trop petit ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilun.GT. jfiltnu+ 2 )  THEN
+           PRINT *,' le parametre nfilun utilise pour la matrice ', &
+      ' matriceun est trop grand ! Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
+            PRINT *,' le parametre nfilus utilise pour la matrice ', &
+         ' matriceus  est trop petit !  '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ', &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
+           PRINT *,' le parametre nfilus utilise pour la matrice ', &
+       ' matriceus  est trop grand ! ' 
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' , &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvn.LT. jfiltnv )  THEN
+            PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+         ' matricevn  est trop petit ! '  
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
+           PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+      ' matricevn est trop grand !  Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
+            PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+         ' matricevs  est trop petit !  Le changer dans parafilt.h '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+       , jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
+           PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+       ' matricevs  est trop grand ! Gachis de memoire ! '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+         ,  jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+
+!  
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
+!                       sur la grille scalaire                 ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
+#else
+#ifdef BLAS
+         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+         eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceun(i,k,j) = 0.0
+            DO ii = 1, iim
+               matriceun(i,k,j) = matriceun(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnv, iim, eignft, iim, 0.0, &
+                 matriceus(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceus(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1) &
+                                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
+!                       sur la grille   de V ou de Z           ........
+!   ...................................................................
+!
+        DO j = 1, jfiltnv
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+           DO k = 1, iim
+            eignft(i,k) = eignfnu(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matricevn(i,k,j) = matricevn(i,k,j) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsv, jjm
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+            DO k = 1, iim
+             eignft(i,k) = eignfnu(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnu, iim, eignft, iim, 0.0, &
+                 matricevs(1,1,j-jfiltsv+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevs(i,k,j-jfiltsv+1) = 0.0
+            DO ii = 1, iim
+               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
+!              sur la grille scalaire , pour le filtre inverse ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i = 1,iim
+          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matrinvn(i,k,j) = matrinvn(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i = 1,iim
+          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+       eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvs(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+
+!
+334    FORMAT(1x,24i3)
+755    FORMAT(1x,6f10.3,i3)
+
+       RETURN
+       END SUBROUTINE inifilr
+
+END MODULE  filtreg_mod
Index: unk/LMDZ.GENERIC/libf/filtrez/inifilr.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/filtrez/inifilr.F	(revision 1402)
+++ 	(revision )
@@ -1,584 +1,0 @@
-      SUBROUTINE inifilr
-c
-c    ... H. Upadhyaya, O.Sharma   ...
-c
-      IMPLICIT NONE
-c
-c     version 3 .....
-
-c     Correction  le 28/10/97    P. Le Van .
-c  -------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "parafilt.h"
-c  -------------------------------------------------------------------
-#include "comgeom.h"
-#include "coefils.h"
-#include "logic.h"
-#include "serre.h"
-
-      REAL  dlonu(iim),dlatu(jjm)
-      REAL  rlamda( iim ),  eignvl( iim )
-c
-
-      REAL    lamdamax,pi,cof
-      INTEGER i,j,modemax,imx,k,kf,ii
-      REAL dymin,dxmin,colat0
-      REAL eignft(iim,iim), coff
-      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
-      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
-     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
-     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
-#ifdef CRAY
-      INTEGER   ISMIN
-      EXTERNAL  ISMIN
-      INTEGER iymin 
-      INTEGER ixmineq
-#endif
-      EXTERNAL  inifgn
-c
-c ------------------------------------------------------------
-c   This routine computes the eigenfunctions of the laplacien
-c   on the stretched grid, and the filtering coefficients
-c      
-c  We designate:
-c   eignfn   eigenfunctions of the discrete laplacien
-c   eigenvl  eigenvalues
-c   jfiltn   indexof the last scalar line filtered in NH
-c   jfilts   index of the first line filtered in SH
-c   modfrst  index of the mode from where modes are filtered
-c   modemax  maximum number of modes ( im )
-c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
-c   sdd      SQRT( dx )
-c      
-c     the modes are filtered from modfrst to modemax
-c      
-c-----------------------------------------------------------
-c
-
-       pi       = 2. * ASIN( 1. )
-
-       DO i = 1,iim
-        dlonu(i) = xprimu( i )
-       ENDDO
-c
-       CALL inifgn(eignvl)
-c
-        print *,' EIGNVL '
-        PRINT 250,eignvl
-250     FORMAT( 1x,5e13.6)
-c
-c compute eigenvalues and eigenfunctions
-c
-c
-c.................................................................
-c
-c  compute the filtering coefficients for scalar lines and 
-c  meridional wind v-lines
-c
-c  we filter all those latitude lines where coefil < 1
-c  NO FILTERING AT POLES
-c
-c  colat0 is to be used  when alpha (stretching coefficient)
-c  is set equal to zero for the regular grid case 
-c
-c    .......   Calcul  de  colat0   .........
-c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
-c
-c
-      DO 45 j = 1,jjm
-         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
- 45   CONTINUE
-c
-#ifdef CRAY
-      iymin   = ISMIN( jjm, dlatu, 1 )
-      ixmineq = ISMIN( iim, dlonu, 1 )
-      dymin   = dlatu( iymin )
-      dxmin   = dlonu( ixmineq )
-#else
-      dxmin   =  dlonu(1)
-       DO  i  = 2, iim
-        dxmin = MIN( dxmin,dlonu(i) )
-       ENDDO
-      dymin  = dlatu(1)
-       DO j  = 2, jjm
-        dymin = MIN( dymin,dlatu(j) )
-       ENDDO
-#endif
-c
-c
-      colat0  =  MIN( 0.5, dymin/dxmin )
-c
-      IF( .NOT.fxyhypb.AND.ysinus )  THEN
-           colat0 = 0.6
-c         ...... a revoir  pour  ysinus !   .......
-           alphax = 0.
-      ENDIF
-c
-      PRINT 50, colat0,alphax
-  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
-c
-      IF(alphax.EQ.1. )  THEN
-        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
-         STOP
-      ENDIF
-c
-      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
-
-cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
-c
-      DO 71 i = 2,iim
-       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
- 71   CONTINUE
-c
-
-      DO 72 j = 1,jjm
-	    DO 73 i = 1,iim
-	    coefilu( i,j )  = 0.0
-	    coefilv( i,j )  = 0.0
-	    coefilu2( i,j ) = 0.0
-	    coefilv2( i,j ) = 0.0
- 73     CONTINUE
- 72   CONTINUE
-
-c
-c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
-c    .........................................................
-c
-       modemax = iim
-
-cccc    imx = modemax - 4 * (modemax/iim)
-
-       imx  = iim
-c
-       PRINT *,' TRUNCATION AT ',imx
-c
-      DO 75 j = 2, jjm/2+1
-       cof = COS( rlatu(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
-        ENDIF
-
-       cof = COS( rlatu(jjp1-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
-     $      jfiltsu= jjp1-j+1
-        ENDIF
- 75   CONTINUE
-c
-      DO 76 j = 1, jjm/2
-       cof = COS( rlatv(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
-        ENDIF
-
-       cof = COS( rlatv(jjm-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
-     $       jfiltsv= jjm-j+1
-        ENDIF
- 76   CONTINUE
-c                                 
-
-      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
-        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
-        STOP
-      ENDIF
-
-      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
-        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
-        STOP
-      ENDIF
-
-      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
-        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
-        STOP
-      ENDIF
-
-      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
-        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
-        STOP
-      ENDIF
-
-       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
-     *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
-
-c                                 
-c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
-c................................................................
-c
-c
-      DO 77 j = 1,jjm
-	  modfrstu( j ) = iim
-	  modfrstv( j ) = iim
- 77   CONTINUE
-c
-      DO 84 j = 2,jfiltnu
-       DO 81 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 82
- 81    CONTINUE
-      GOTO 84
- 82   modfrstu( j ) = k
-c
-	  kf = modfrstu( j )
-	   DO 83 k = kf , modemax
-        cof = rlamda(k) * COS( rlatu(j) )
-	    coefilu(k,j) = cof - 1.
-	    coefilu2(k,j) = cof*cof - 1.
- 83    CONTINUE
- 84   CONTINUE
-c                                 
-c
-      DO 89 j = 1,jfiltnv
-c
-       DO 86 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 87
- 86    CONTINUE
-      GOTO 89
- 87   modfrstv( j ) = k
-c
-	   kf = modfrstv( j )
-	   DO 88 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 88    CONTINUE
-c
- 89    CONTINUE
-c
-      DO 94 j = jfiltsu,jjm
-       DO 91 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 92
- 91    CONTINUE
-      GOTO 94
- 92   modfrstu( j ) = k
-c
-        kf = modfrstu( j )
-	 DO 93 k = kf , modemax
-          cof = rlamda(k) * COS( rlatu(j) )
-	  coefilu(k,j) = cof - 1.
-	  coefilu2(k,j) = cof*cof - 1.
- 93      CONTINUE
- 94    CONTINUE
-c                                 
-      DO 99 j = jfiltsv,jjm
-       DO 96 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 97
- 96    CONTINUE
-      GOTO 99
- 97   modfrstv( j ) = k
-c
-       kf = modfrstv( j )
-	   DO 98 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 98    CONTINUE
- 99   CONTINUE
-c
-
-       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
-
-         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
-         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
-
-          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
-     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
-       ENDIF
-
-       PRINT *,'   Modes premiers  v  '
-       PRINT 334,modfrstv
-       PRINT *,'   Modes premiers  u  '
-       PRINT 334,modfrstu
-
-     
-      IF( nfilun.LT. jfiltnu )  THEN
-       PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *   ' matriceun  est trop petit ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilun.GT. jfiltnu+ 2 )  THEN
-           PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *' matriceun est trop grand ! Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
-            PRINT *,' le parametre nfilus utilise pour la matrice ',
-     *   ' matriceus  est trop petit !  '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ',
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
-           PRINT *,' le parametre nfilus utilise pour la matrice ',
-     * ' matriceus  est trop grand ! ' 
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvn.LT. jfiltnv )  THEN
-            PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *   ' matricevn  est trop petit ! '  
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
-           PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *' matricevn est trop grand !  Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
-            PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     * , jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
-           PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     * ' matricevs  est trop grand ! Gachis de memoire ! '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     *   ,  jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-
-c  
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
-c                       sur la grille scalaire                 ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
-#else
-#ifdef BLAS
-         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceun(i,k,j) = 0.0
-            DO ii = 1, iim
-               matriceun(i,k,j) = matriceun(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnv, iim, eignft, iim, 0.0, 
-     $           matriceus(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceus(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
-     .                                    + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
-c                       sur la grille   de V ou de Z           ........
-c   ...................................................................
-c
-        DO j = 1, jfiltnv
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-           DO k = 1, iim
-            eignft(i,k) = eignfnu(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matricevn(i,k,j) = matricevn(i,k,j)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsv, jjm
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-            DO k = 1, iim
-             eignft(i,k) = eignfnu(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnu, iim, eignft, iim, 0.0, 
-     $           matricevs(1,1,j-jfiltsv+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevs(i,k,j-jfiltsv+1) = 0.0
-            DO ii = 1, iim
-               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
-c              sur la grille scalaire , pour le filtre inverse ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i = 1,iim
-          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matrinvn(i,k,j) = matrinvn(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i = 1,iim
-          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvs(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-
-c
-334    FORMAT(1x,24i3)
-755    FORMAT(1x,6f10.3,i3)
-
-       RETURN
-       END
Index: /trunk/LMDZ.GENERIC/libf/filtrez/parafilt.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/filtrez/parafilt.h	(revision 1402)
+++ /trunk/LMDZ.GENERIC/libf/filtrez/parafilt.h	(revision 1403)
@@ -1,45 +1,40 @@
         INTEGER nfilun, nfilus, nfilvn, nfilvs
-c
-c 48 32 19 non-zoom:
-c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
-c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
-c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
-c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
-cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
-c
-c
-c 96 49 11 non-zoom:
-ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
-c
-c
-c 144 73 11 non-zoom:
-ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
-c
-c 192 143 19 non-zoom:
-c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
-c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
-c      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
+!
+! 48 32 19 non-zoom:
+!       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
+!        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
+!         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
+!        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
+!maf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
+!
+!
+! 96 49 11 non-zoom:
+!cc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
+!
+!
+! 144 73 11 non-zoom:
+!cc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
+!
+! 192 143 19 non-zoom:
+!             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
+!      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
+!      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
 !!        PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
-!        PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
+        PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
+! 96 72 19 non-zoom:
+!cc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
+!
+!        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
+!       PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
+!
+!
+!      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
+!
+!      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
+!
+!      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
+!
+!      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
+!
+!      Parameter  ci-dessus  et de relancer  le  run .  
 
-        PARAMETER (nfilun=11,nfilus=11,nfilvn=11,nfilvs=11)
-!        PARAMETER (nfilun=12,nfilus=12,nfilvn=12,nfilvs=12)
-
-
-c 96 72 19 non-zoom:
-ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
-c
-c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
-c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
-c
-c
-c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
-c
-c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
-c
-c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
-c
-c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
-c
-c      Parameter  ci-dessus  et de relancer  le  run .  
-
Index: /trunk/LMDZ.GENERIC/libf/misc/cbrt.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/cbrt.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/cbrt.F	(revision 1403)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/misc/cvmgp.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/cvmgp.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/cvmgp.F	(revision 1403)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: /trunk/LMDZ.GENERIC/libf/misc/cvmgt.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/cvmgt.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/cvmgt.F	(revision 1403)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: /trunk/LMDZ.GENERIC/libf/misc/ilsum.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ilsum.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ilsum.F	(revision 1403)
@@ -0,0 +1,19 @@
+      FUNCTION ilsum(n, logic, inc)
+c
+      IMPLICIT NONE
+c
+      integer ilsum
+      integer n, inc
+      logical logic((n-1)*inc+1)
+c
+      integer i, in
+c
+      ilsum = 0.
+      in = 1
+      do 10 i = 1, n
+         if (logic(in)) ilsum = ilsum + 1
+         in=in+inc
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/iniprint.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/iniprint.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/iniprint.h	(revision 1403)
@@ -0,0 +1,11 @@
+!
+! $Id: $
+!
+!
+! handle debug and output levels
+! lunout:    unit of file where outputs will be sent
+!                           (default is 6, standard output)
+! prt_level: level of informative output messages (0 = minimum)
+!
+      INTEGER lunout, prt_level
+      COMMON /comprint/ lunout, prt_level
Index: /trunk/LMDZ.GENERIC/libf/misc/ioipsl_errioipsl.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
@@ -0,0 +1,219 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE ioipsl_errioipsl
Index: /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom.F90	(revision 1403)
@@ -0,0 +1,1980 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the run.def file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the run.def file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from run.def
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = 'run.def'
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file='run.def.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of run.def and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE ioipsl_getincom
Index: /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom_p.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom_p.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ioipsl_getincom_p.F90	(revision 1403)
@@ -0,0 +1,170 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom_p
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_getincom ! to use  'getin'
+USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
+use mod_phys_lmdz_para, only : bcast
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin_p
+!-
+INTERFACE getin_p
+
+  MODULE PROCEDURE getinrs_p, getinr1d_p, getinr2d_p, &
+ &                 getinis_p, getini1d_p, getini2d_p, &
+ &                 getincs_p, 		              &
+ &                 getinls_p, getinl1d_p, getinl2d_p
+END INTERFACE
+!-
+CONTAINS
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition des getin -> bcast      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaines de caracteres -- !!
+  
+  SUBROUTINE getincs_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut    
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getincs_p
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE getinis_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut    
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinis_p
+
+  SUBROUTINE getini1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getini1d_p
+
+  SUBROUTINE getini2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getini2d_p
+
+!! -- Les flottants -- !!
+  
+  SUBROUTINE getinrs_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinrs_p
+
+  SUBROUTINE getinr1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinr1d_p
+
+  SUBROUTINE getinr2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinr2d_p
+
+!! -- Les Booleens -- !!
+  
+  SUBROUTINE getinls_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinls_p
+
+  SUBROUTINE getinl1d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinl1d_p
+
+  SUBROUTINE getinl2d_p(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:,:)
+
+!$OMP BARRIER
+    IF (is_mpi_root .AND. is_omp_root) THEN
+    	CALL getin(VarIn,VarOut)
+    ENDIF
+    CALL bcast(VarOut)
+  END SUBROUTINE getinl2d_p
+!-
+!-----------------------------
+!-----------------------------
+!-----------------------------
+
+END MODULE ioipsl_getincom_p
Index: /trunk/LMDZ.GENERIC/libf/misc/ioipsl_stringop.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ioipsl_stringop.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ioipsl_stringop.F90	(revision 1403)
@@ -0,0 +1,243 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE ioipsl_stringop
Index: /trunk/LMDZ.GENERIC/libf/misc/isamax.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/isamax.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/isamax.F	(revision 1403)
@@ -0,0 +1,21 @@
+      function isamax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,isamax,ix
+      real sx((n-1)*incx+1),sxmax,abssx
+c
+      ix=1
+      isamax=1
+      sxmax=ABS(sx(1))
+      do 10 i=1,n-1
+         ix=ix+incx
+         abssx=ABS(sx(ix))
+         if(abssx.gt.sxmax) then
+             sxmax=abssx
+             isamax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/isitor.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/isitor.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/isitor.F	(revision 1403)
@@ -0,0 +1,64 @@
+
+      SUBROUTINE isitor(filename,writeornot,filenum, files)
+
+C--------------------------------------------------------------------
+C Subroutine qui determine si un fichier doit etre ecrit ou non
+C--------------------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     filename: CHARACTER*20 
+C               nom du fichier dont on veut savoir si il doit etre ecrit
+C     writeornot: LOGICAL
+C                 Variable de sortie qui est vraie si le champ doit etre ecrit
+C     filenum: INTEGER
+C              nombre de fichier dans la list files
+C     files: CHARACTER*20 files(100)
+C            c'est la liste des fichier qui doivent etre ecrit et dans
+C            lequel on vas voir si filename y est.
+C
+
+
+      IMPLICIT NONE
+      CHARACTER*20 filename, checkname
+      CHARACTER*1 separator
+      LOGICAL writeornot, check
+      INTEGER iletter, ifile
+      INTEGER filenum
+      CHARACTER*20 files(100)
+
+      writeornot = .FALSE.
+      check = .FALSE.
+      separator = '/'
+
+      DO 6565 iletter = 20,1,-1
+
+        IF (filename(iletter:iletter) .EQ. separator) THEN
+
+          checkname = filename(iletter+1:20)
+    
+        ELSE
+        ENDIF
+ 6565 CONTINUE
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: filename=',filename,
+     &             'checkname=',checkname
+      ENDIF
+
+      DO 6767 ifile = 1,filenum
+
+      IF (files(ifile) .EQ. checkname ) THEN
+       
+      writeornot = .TRUE. 
+
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
+      ENDIF
+
+ 6767 CONTINUE
+
+      RETURN
+      END
+
Index: /trunk/LMDZ.GENERIC/libf/misc/ismax.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ismax.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ismax.F	(revision 1403)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/ismin.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ismin.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ismin.F	(revision 1403)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+	 ix=ix+incx
+	 if(sx(ix).lt.sxmin) then
+	     sxmin=sx(ix)
+	     ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/mxm.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/mxm.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/mxm.F	(revision 1403)
@@ -0,0 +1,34 @@
+       SUBROUTINE MXM(A,NAR,B,NAC,C,NBC)
+c
+c
+c    Multiplication of matrix A by matrix B ,and result in matrix C
+c
+c
+c      NAR : number of   rows  for matrix  A and  matrix  C
+c      NAC : number of columns for matrix  A and number of rows
+c                              for matrix  B
+c      NBC : number of columns for matrix  B and  matrix  C
+c
+c
+       IMPLICIT NONE
+c
+       INTEGER  NAR,NAC,NBC, I,J,K
+       REAL     A(NAR,NAC), B(NAC,NBC), C(NAR,NBC)
+c
+       DO 10 J = 1,NBC
+       DO 10 I = 1,NAR
+       C(I,J)=0.
+10     CONTINUE
+c
+       DO 50 J = 1,NBC
+       DO 40 I = 1,NAR
+
+       DO 20 K = 1,NAC
+       C(I,J)  = C(I,J) + A(I,K) * B(K,J)
+20     CONTINUE
+
+40     CONTINUE
+50     CONTINUE
+
+       RETURN
+       END
Index: /trunk/LMDZ.GENERIC/libf/misc/mxv.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/mxv.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/mxv.F	(revision 1403)
@@ -0,0 +1,20 @@
+      SUBROUTINE MXV(A,NRA,B,NCA,C)
+      IMPLICIT NONE
+
+      INTEGER NRA,NCA
+      REAL A(NRA,NCA), B(NCA), C(NRA)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+         C(I) = 0.
+100   CONTINUE
+c     multiply matrix A and vector B
+      DO 220 J = 1, NCA
+         DO 210 I = 1, NRA
+            C(I) = C(I) + A(I,J)*B(J)
+210     CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/misc/mxva.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/mxva.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/mxva.F	(revision 1403)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(*), SB(*), SC(*)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: /trunk/LMDZ.GENERIC/libf/misc/scopy.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/scopy.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/scopy.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/scopyi.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/scopyi.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/scopyi.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/sdot.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/sdot.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/sdot.F	(revision 1403)
@@ -0,0 +1,21 @@
+      FUNCTION sdot (n, x,incx, y,incy)
+      IMPLICIT NONE
+c
+      integer n, incx, incy
+      real sdot
+      real x((n-1)*incx+1), y((n-1)*incy+1)
+c
+      integer i, ix, iy
+c
+      sdot = 0.0
+      ix = 1
+      iy = 1
+c
+      do 10 i = 1, n
+         sdot = sdot + x(ix) * y(iy)
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/ssum.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/ssum.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/ssum.F	(revision 1403)
@@ -0,0 +1,16 @@
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+      ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.GENERIC/libf/misc/wheneq.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/misc/wheneq.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/misc/wheneq.F	(revision 1403)
@@ -0,0 +1,23 @@
+      SUBROUTINE wheneq(n,x,incx,target,index,nn)
+      IMPLICIT NONE
+c
+      integer n, incx, nn
+      integer index(n)
+c
+      integer target, x((n-1)*incx+1)
+cccccc      real target, x((n-1)*incx+1)
+c
+      integer i, ix
+c
+      ix = 1
+      nn = 0
+      do 10 i = 1, n
+         if (x(ix).EQ.target) then
+            index(i) = ix
+            nn = nn + 1
+         endif
+         ix = ix + incx
+   10 continue
+c
+      return
+      end
Index: unk/LMDZ.GENERIC/libf/phystd/calcenergy_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/calcenergy_kcm.F90	(revision 1402)
+++ 	(revision )
@@ -1,75 +1,0 @@
-subroutine calcenergy_kcm(nlayer,Tsurf,T,Play,Plev,Qsurf,Q,muvar,Eatmtot)
-
-
-use params_h, only : Rc
-use watercommon_h, only : mH2O
-use comcstfi_mod, only: g, mugaz
-implicit none
-
-!     ----------------------------------------------------------------
-!     Purpose: Calculate total energy of the (steam) atmosphere
-!     Authour: R. Wordsworth (2011)
-!     ----------------------------------------------------------------
-
-
-  ! inputs
-  integer,intent(in) :: nlayer
-  real Tsurf,T(1:nlayer)
-  real Play(1:nlayer),Plev(1:nlayer+1)
-  real Qsurf,Q(1:nlayer)
-  real muvar(1,nlayer+1)
-
-  ! internal
-  integer il
-  real m_n,m_v,cp_n,cp_v,cp_a,Eatmlay
-  real s_c,rho_v,L
-  double precision p_v, s_v, nul
-  real VMR(1:nlayer)
-
-  ! output
-  real Eatmtot
-
-  ! functions
-  double precision cp_neutral
-
-  m_n = mugaz/1000.
-  m_v = mH2O/1000.
-
-
-  do il=1,nlayer
-     VMR(il)=Q(il)*(muvar(1,il+1)/mH2O)
-  end do
-
-
-  Eatmtot = 0.0
-  do il=1,nlayer
-
-
-     cp_n = cp_neutral(dble(T(il)))
-     cp_v = (32.24+1.923d-3*T(il) + 1.055d-5*T(il)**2-3.511d-9*T(il)**3)/m_v
-     ! / by m_v makes it per kg not per mol
-
-     call psat_H2O(dble(T(il)),p_v)
-     p_v   = p_v*1d6
-     rho_v = real(p_v)*m_v/(real(Rc)*T(il))
-
-     call therm(dble(T(il)),dble(rho_v)*1d-3,nul,nul,nul,nul,nul,nul,nul,&
-                nul,nul,nul,s_v,nul)
-
-     s_c = 2.06 * log(T(il)/273.15)
-     s_v = s_v * 1d3
-     s_c = s_c * 1d3
-     L   = (real(s_v)-s_c)*T(il)
-
-     cp_a    = (1-VMR(il))*cp_n + VMR(il)*cp_v 
-     !cp_a    = (1-Q(il))*cp_n + Q(il)*cp_v 
-
-     Eatmlay = ( cp_a*T(il) + L*VMR(il) ) * (Plev(il)-Plev(il+1))/g
-
-     Eatmtot = Eatmtot + Eatmlay 
-  enddo
-
-  print*,'WARNING: E-calc currently assumes H2O saturation!'
-
-end subroutine calcenergy_kcm
-
Index: unk/LMDZ.GENERIC/libf/phystd/datareadnc.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/datareadnc.F	(revision 1402)
+++ 	(revision )
@@ -1,287 +1,0 @@
-c=======================================================================
-      SUBROUTINE datareadnc(relief,filename,phisinit,alb,ith,
-     .                    zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c
-c
-c   Author: F. Hourdin      01/1997
-c   -------
-c
-c   Object: To read data from Martian surface to use in a GCM
-c   ------                from NetCDF file "surface.nc"
-c
-c
-c   Arguments:
-c   ----------
-c
-c     Inputs:
-c     ------
-c
-c     Outputs:
-c     --------
-c
-c=======================================================================
-c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
-c
-c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
-c
-c   360 valeurs en longitude (de -179.5 a 179.5)
-c   180 valeurs en latitudes (de 89.5 a -89.5)
-c
-c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
-c
-c   Il faut donc que ces donnees soient au format grille scalaire
-c               (imold+1 jmold+1)
-c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
-c
-c   On prend imd (d pour donnees!) 
-c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
-c                   (rlonud de -179 a -181)
-c           jmd = 179 
-c                   (rlatvd de 89 a -89)
-c=======================================================================
-
-      use datafile_mod, only: datadir
-! to use  'getin'
-      USE ioipsl_getincom 
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comconst.h"
-#include "netcdf.inc"
-
-c=======================================================================
-c   Declarations:
-C=======================================================================
-
-      INTEGER    imd,jmd,imdp1,jmdp1
-      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
-
-      INTEGER    iimp1
-      parameter    (iimp1=iim+1-1/iim)
-
-      character(len=3),intent(inout) :: relief*3
-      character(len=*),intent(in) :: filename ! surface.nc file
-      real,intent(out) :: phisinit(iimp1*jjp1) ! surface geopotential
-      real,intent(out) :: alb(iimp1*jjp1) ! albedo
-      real,intent(out) :: ith(iimp1*jjp1) ! thermal inertia
-      real,intent(out) :: zmea(imdp1*jmdp1)
-      real,intent(out) :: zstd(imdp1*jmdp1)
-      real,intent(out) :: zsig(imdp1*jmdp1)
-      real,intent(out) :: zgam(imdp1*jmdp1)
-      real,intent(out) :: zthe(imdp1*jmdp1)
-      
-      REAL        zdata(imd*jmdp1)
-      REAL        zdataS(imdp1*jmdp1)
-      REAL        pfield(iimp1*jjp1)
-
-      INTEGER   ierr
-
-      INTEGER   unit,nvarid
-
-      INTEGER    i,j,k
-
-      INTEGER klatdat,ngridmixgdat
-      PARAMETER (klatdat=180,ngridmixgdat=360)
-
-c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
-
-      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
-      REAL rlonud(imdp1),rlatvd(jmd)
-
-      CHARACTER*20 string
-      DIMENSION string(4)
-
-#include "fxyprim.h"
-
-      pi=2.*ASIN(1.)
-
-c=======================================================================
-c    rlonud, rlatvd
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF des donnees latitude et longitude
-c-----------------------------------------------------------------------
-      ierr = NF_OPEN (trim(datadir)//'/'//trim(adjustl(filename)),
-     &  NF_NOWRITE,unit)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(*,*)'Error : cannot open file '//trim(filename)
-        write(*,*)'(in phystd/datareadnc.F)'
-        write(*,*)'It should be in :',trim(datadir),'/'
-        write(*,*)'Check that your path to datagcm:',trim(datadir)
-        write(*,*)' is correct. You can change it in callphys.def with:'
-        write(*,*)' datadir = /absolute/path/to/datagcm'
-        write(*,*)'If necessary surface.nc (and other datafiles)'
-        write(*,*)' can be obtained online on:'
-        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
-        STOP
-      ENDIF
-
-c
-c Lecture des latitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
-#endif
-c
-c Lecture des longitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
-#endif
-
-c-----------------------------------------------------------------------
-c    Passage au format boites scalaires
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c       longitude(imd)        -->      rlonud(imdp1) 
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do i=1,imd 
-          rlonud(i)=(longitude(i)+.5)*pi/180.
-      enddo
-
-c Repetition de la valeur im+1
-      rlonud(imdp1)=rlonud(1) + 2*pi
-
-c-----------------------------------------------------------------------
-c        latitude(jmdp1)         -->        rlonvd(jmd)
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do j=1,jmd 
-          rlatvd(j)=(latitude(j)-.5)*pi/180.
-      enddo
-
-c=======================================================================
-c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
-c=======================================================================
-
-      string(1) = 'albedo'
-      string(2) = 'thermal'
-      if (relief.ne.'pla') then
-        write(*,*) ' La topographie est celle de MOLA'
-        relief = 'MOL'
-          string(3) = 'z'//relief
-      else
-          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
-                            ! remise a 0 derriere
-      endif
-      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
- 
-
-      DO k=1,4
-          write(*,*) 'string',k,string(k)
-          
-c-----------------------------------------------------------------------
-c    initialisation
-c-----------------------------------------------------------------------
-      call initial0(iimp1*jjp1,pfield)
-      call initial0(imd*jmdp1,zdata)
-      call initial0(imdp1*jmdp1,zdataS)
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF  
-c-----------------------------------------------------------------------
-
-      ierr = NF_INQ_VARID (unit, string(k), nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
-#endif
-
-c-----------------------------------------------------------------------
-c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
-c-----------------------------------------------------------------------
-      if (k.eq.4) then
-
-          call multscal(imd*jmdp1,zdata,1000.,zdata)
-          call multscal(imd,longitude,pi/180.,longitude)
-          call multscal(jmdp1,latitude,pi/180.,latitude)
-
-          call grid_noro1(360, 180, longitude, latitude, zdata,
-     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
-
-          !CALL dump2d(iip1,jjp1,zmea,'zmea')
-          !CALL dump2d(iip1,jjp1,zstd,'zstd')
-          !CALL dump2d(iip1,jjp1,zsig,'zsig')
-          !CALL dump2d(iip1,jjp1,zgam,'zgam')
-          !CALL dump2d(iip1,jjp1,zthe,'zthe')
-
-      endif
-
-c-----------------------------------------------------------------------
-c   Passage de zdata en grille (imdp1 jmdp1)
-c-----------------------------------------------------------------------
-      do j=1,jmdp1
-          do i=1,imd
-              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmixgdat*(j-1))
-          enddo
-          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmixgdat*(j-1))
-      enddo
-
-c-----------------------------------------------------------------------
-c    Interpolation
-c-----------------------------------------------------------------------
-      call interp_horiz(zdataS,pfield,imd,jmd,
-     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
-
-c-----------------------------------------------------------------------
-c    Periodicite    
-c-----------------------------------------------------------------------
-
-      do j=1,jjp1
-         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
-      enddo 
- 
-c-----------------------------------------------------------------------
-c    Sauvegarde des champs    
-c-----------------------------------------------------------------------
-
-      if (k.eq.1) then                    ! albedo
-         do i=1,iimp1*jjp1
-              alb(i) = pfield(i)
-          enddo
-      elseif (k.eq.2) then                ! thermal
-         do i=1,iimp1*jjp1
-              ith(i) = pfield(i)
-          enddo
-      elseif (k.eq.3) then                ! relief
-        if (relief.eq.'pla') then
-              call initial0(iimp1*jjp1,phisinit)
-        else
-             do i=1,iimp1*jjp1
-                  phisinit(i) = pfield(i)
-              enddo
-        endif
-      endif
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c    Traitement Phisinit
-c-----------------------------------------------------------------------
-
-      DO i=1,iimp1*jjp1
-            phisinit(i)=1000.*phisinit(i)
-      ENDDO
-      !CALL dump2d(iimp1,jjp1,phisinit,'Altitude en m')
-      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
-
-c-----------------------------------------------------------------------
-c    FIN
-c-----------------------------------------------------------------------
-
-      END
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/abort_gcm.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/abort_gcm.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/abort_gcm.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/abort_gcm.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/calcenergy_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/calcenergy_kcm.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/calcenergy_kcm.F90	(revision 1403)
@@ -0,0 +1,75 @@
+subroutine calcenergy_kcm(nlayer,Tsurf,T,Play,Plev,Qsurf,Q,muvar,Eatmtot)
+
+
+use params_h, only : Rc
+use watercommon_h, only : mH2O
+use comcstfi_mod, only: g, mugaz
+implicit none
+
+!     ----------------------------------------------------------------
+!     Purpose: Calculate total energy of the (steam) atmosphere
+!     Authour: R. Wordsworth (2011)
+!     ----------------------------------------------------------------
+
+
+  ! inputs
+  integer,intent(in) :: nlayer
+  real Tsurf,T(1:nlayer)
+  real Play(1:nlayer),Plev(1:nlayer+1)
+  real Qsurf,Q(1:nlayer)
+  real muvar(1,nlayer+1)
+
+  ! internal
+  integer il
+  real m_n,m_v,cp_n,cp_v,cp_a,Eatmlay
+  real s_c,rho_v,L
+  double precision p_v, s_v, nul
+  real VMR(1:nlayer)
+
+  ! output
+  real Eatmtot
+
+  ! functions
+  double precision cp_neutral
+
+  m_n = mugaz/1000.
+  m_v = mH2O/1000.
+
+
+  do il=1,nlayer
+     VMR(il)=Q(il)*(muvar(1,il+1)/mH2O)
+  end do
+
+
+  Eatmtot = 0.0
+  do il=1,nlayer
+
+
+     cp_n = cp_neutral(dble(T(il)))
+     cp_v = (32.24+1.923d-3*T(il) + 1.055d-5*T(il)**2-3.511d-9*T(il)**3)/m_v
+     ! / by m_v makes it per kg not per mol
+
+     call psat_H2O(dble(T(il)),p_v)
+     p_v   = p_v*1d6
+     rho_v = real(p_v)*m_v/(real(Rc)*T(il))
+
+     call therm(dble(T(il)),dble(rho_v)*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                nul,nul,nul,s_v,nul)
+
+     s_c = 2.06 * log(T(il)/273.15)
+     s_v = s_v * 1d3
+     s_c = s_c * 1d3
+     L   = (real(s_v)-s_c)*T(il)
+
+     cp_a    = (1-VMR(il))*cp_n + VMR(il)*cp_v 
+     !cp_a    = (1-Q(il))*cp_n + Q(il)*cp_v 
+
+     Eatmlay = ( cp_a*T(il) + L*VMR(il) ) * (Plev(il)-Plev(il+1))/g
+
+     Eatmtot = Eatmtot + Eatmlay 
+  enddo
+
+  print*,'WARNING: E-calc currently assumes H2O saturation!'
+
+end subroutine calcenergy_kcm
+
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comconst.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comconst.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comconst.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comconst.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comgeom.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comgeom.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comgeom.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comgeom.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comvert.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comvert.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/comvert.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comvert.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/control_mod.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/control_mod.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/control_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/control_mod.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/disvert.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/disvert.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/disvert.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/disvert.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/diverg.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/diverg.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/diverg.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/diverg.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/ener.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/ener.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/ener.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/ener.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/gr_dyn_fi.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_fi_dyn.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_fi_dyn.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/gr_fi_dyn.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_u_scal.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_u_scal.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_u_scal.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/gr_u_scal.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_v_scal.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_v_scal.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gr_v_scal.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/gr_v_scal.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/grad.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/grad.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/grad.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/grad.F
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gradients_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gradients_kcm.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/gradients_kcm.F90	(revision 1403)
@@ -0,0 +1,126 @@
+subroutine gradients_kcm(profil_flag,rho_v,rho_n,T,dTdp,dPvdp,dPndp)
+
+  use params_h
+  use gases_h
+  implicit none
+
+  ! inputs
+  integer profil_flag ! 0 = dry, 1 = moist, 2 = isothermal
+  double precision rho_v,rho_n,T
+
+  ! outputs
+  double precision dTdp,dPndp,dPvdp
+  double precision a_v
+
+  ! internal
+  !double precision cp_n,cp_v
+  double precision cp_v
+
+  double precision press, rho_plus, rho_minus, dVdT, rho_c
+  double precision dlnr,dlna,dpsat,dsv
+  double precision s_minus,s_plus
+  double precision s_v,s_c,L
+  double precision psat_plus,psat_minus,Pn
+  double precision nul
+
+  ! functions
+  double precision cp_neutral
+
+  !cp_n = cp_neutral(T)
+
+  select case(profil_flag)
+  case(2) ! isothermal
+
+     dTdp  = 0.
+     a_v   = rho_v/rho_n ! constant here
+     dPndp = 1/(1d0+m_n/m_v*a_v)
+     dPvdp = 1 - dPndp
+
+  case(1) ! moist
+
+     Pn = rho_n*T*rmn
+
+     if(ngasmx.eq.1)then
+        print*,'Cannot have moist adiabat with one gas...'
+        stop
+     endif
+
+     if(trim(gnom(ngasmx)).eq.'H2O')then
+
+        call psat_H2O(T-2d-1,psat_minus)
+        call psat_H2O(T+2d-1,psat_plus)
+        call psat_H2O(T,press)
+
+        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
+        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
+
+        call therm(T-2d-1,rho_minus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                   nul,nul,press,s_minus,nul)
+        call therm(T+2d-1,rho_plus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
+                   nul,nul,press,s_plus,nul)
+        s_c = 2.06 * log(T/273.15)
+
+        s_plus  = s_plus  * 1d3
+        s_minus = s_minus * 1d3
+        s_c     = s_c     * 1d3 ! convert to SI
+
+        if(T.lt.280.0)then 
+           dpsat = press*1d6 * ( 1730.63*log(10.) / (T-39.714)**2 )
+        else
+           call tdpsdt(T,dpsat)
+           dpsat = dpsat * 1d6 / T
+        endif
+
+     elseif(trim(gnom(ngasmx)).eq.'NH3')then
+
+        call psat_NH3(T-2d-1,psat_minus)
+        call psat_NH3(T+2d-1,psat_plus)
+        call psat_NH3(T,press)
+
+        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
+        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
+
+        call latheat_NH3(T-2d-1,nul,s_minus)
+        call latheat_NH3(T+2d-1,nul,s_plus)
+        call latheat_NH3(T,s_c,nul)
+
+        dpsat = press*1d6 * (-2*1.5609d-4*T + 0.1236)
+
+     endif
+
+     dsv  = (s_plus-s_minus)/4d-1  ! dsv*T = ds / d ln[T]
+     s_v  = (s_plus+s_minus)/2d0
+     dlnr = T/rho_v * (rho_plus-rho_minus)/4d-1  ! d ln[rho_v] / d ln[T]
+
+     if(rho_n/rho_v.lt.1e-5)then
+        dlna = -T*dsv/(s_v-s_c)
+     else
+        a_v  = rho_v/rho_n
+        dlna = (rmn*dlnr - cp_n + rmn - a_v*T*dsv)/(a_v*(s_v-s_c)+rmn)  
+        ! d ln[alpha_v] / d ln[T]
+        ! note cp_n + rmn = cv_n, which is what's required
+     endif
+
+     dTdp  = 1d0 / (dpsat + rho_n*rmn*(1d0 + dlnr - dlna)) ! c.f. Marcq S2.2.2
+     dPvdp = dTdp * dpsat
+     dPndp = 1d0 - dPvdp ! from p = p_v + p_n
+
+  case(0) ! dry
+
+     cp_v=0.0
+     if(trim(gnom(ngasmx)).eq.'H2O')then
+        cp_v = (32.24+1.923d-3*T+1.055d-5*T**2-3.511d-9*T**3)/m_v
+     elseif(trim(gnom(ngasmx)).eq.'NH3')then
+        cp_v = 2.058d3
+     elseif(trim(gnom(ngasmx)).eq.'CH4')then
+        cp_v = 2.226d3
+     endif
+
+     dTdp  = 1/(rho_n*cp_n+rho_v*cp_v)
+     dPndp = 1/(1d0+m_n/m_v*rho_v/rho_n)
+     dPvdp = 1/(1d0+m_v/m_n*rho_n/rho_v)
+      
+  end select
+
+
+end subroutine gradients_kcm
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/infotrac.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/infotrac.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/infotrac.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/infotrac.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcm1d.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcm1d.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcm1d.F90	(revision 1403)
@@ -0,0 +1,373 @@
+program kcm1d
+
+  use infotrac, only: nqtot
+  use radinc_h,      only: NAERKIND
+  use radcommon_h,   only: L_NSPECTI, L_NSPECTV, sigma
+  use watercommon_h, only: mH2O
+  use ioipsl_getincom, only: getin
+  use comsaison_h, only: mu0, fract, dist_star
+  use planete_mod
+  use callkeys_mod, only: check_cpp_match, pceil, tstrat, tracer
+!  use control_mod
+  use comcstfi_mod
+  implicit none
+
+  !==================================================================
+  !     
+  !     Purpose
+  !     -------
+  !     Run the universal model radiative transfer once in a 1D column.
+  !     Useful for climate evolution studies etc.
+  !     
+  !     It can be compiled with a command like (e.g. for 25 layers):
+  !                                  "makegcm -p std -d 25 kcm1d"
+  !     It requires the files "callphys.def", "gases.def"
+  !     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
+  !
+  !     Authors
+  !     -------
+  !     R. Wordsworth
+  !
+  !==================================================================
+
+#include "dimensions.h"
+!#include "dimphys.h"
+
+  ! --------------------------------------------------------------
+  !  Declarations
+  ! --------------------------------------------------------------
+
+  integer nlayer,nlevel,nq
+  integer ilay,ilev,iq,iw,iter
+  real play(llm)     ! Pressure at the middle of the layers [Pa]
+  real zlay(llm)     ! Altitude at middle of the layers [km]
+  real plev(llm+1)   ! Intermediate pressure levels [Pa]
+  real temp(llm)     ! temperature at the middle of the layers [K]
+  real,allocatable :: q(:,:)   ! tracer mixing ratio [kg/kg]
+  real,allocatable :: vmr(:,:) ! tracer mixing ratio [mol/mol]
+  real,allocatable :: qsurf(:)        ! tracer surface budget [kg/kg] ????
+  real psurf,psurf_n,tsurf      
+
+  real emis, albedo
+
+  real muvar(llm+1)
+
+  real dtsw(llm) ! heating rate (K/s) due to SW
+  real dtlw(llm) ! heating rate (K/s) due to LW
+  real fluxsurf_lw   ! incident LW flux to surf (W/m2)
+  real fluxtop_lw    ! outgoing LW flux to space (W/m2)
+  real fluxsurf_sw   ! incident SW flux to surf (W/m2)
+  real fluxabs_sw    ! SW flux absorbed by planet (W/m2)
+  real fluxtop_dn    ! incident top of atmosphere SW flux (W/m2)
+
+  ! not used
+  real reffrad(llm,naerkind)
+  real nueffrad(llm,naerkind)
+  real cloudfrac(llm)
+  real totcloudfrac
+  real tau_col
+
+  real dTstrat
+  real aerosol(llm,naerkind) ! aerosol tau (kg/kg)
+  real OLR_nu(1,L_NSPECTI)
+  real OSR_nu(1,L_NSPECTV)
+  real Eatmtot
+
+  integer ierr
+  logical firstcall,lastcall,global1d
+
+  character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
+
+  ! --------------
+  ! Initialisation
+  ! --------------
+
+  pi=2.E+0*asin(1.E+0)
+
+  reffrad(:,:)  = 0.0
+  nueffrad(:,:) = 0.0
+  cloudfrac(:)  = 0.0
+  totcloudfrac  = 0.0
+
+
+  nlayer=llm
+  nlevel=nlayer+1
+
+  !! this is defined in comsaison_h
+  ALLOCATE(mu0(1))
+  ALLOCATE(fract(1))
+
+
+
+  !  Load parameters from "run.def" 
+  ! -------------------------------
+
+  ! check if 'kcm1d.def' file is around (otherwise reading parameters
+  ! from callphys.def via getin() routine won't work.)
+  open(90,file='kcm1d.def',status='old',form='formatted',&
+       iostat=ierr)
+  if (ierr.ne.0) then
+     write(*,*) 'Cannot find required file "kcm1d.def"'
+     write(*,*) '  (which should contain some input parameters'
+     write(*,*) '   along with the following line:'
+     write(*,*) '   INCLUDEDEF=callphys.def'
+     write(*,*) '   )'
+     write(*,*) ' ... might as well stop here ...'
+     stop
+  else
+     close(90)
+  endif
+
+! now, run.def is needed anyway. so we create a dummy temporary one
+! for ioipsl to work. if a run.def is already here, stop the
+! program and ask the user to do a bit of cleaning
+  open(90,file='run.def',status='old',form='formatted',& 
+       iostat=ierr)
+  if (ierr.eq.0) then
+     close(90)
+     write(*,*) 'There is already a run.def file.'
+     write(*,*) 'This is not compatible with 1D runs.'
+     write(*,*) 'Please remove the file and restart the run.'
+     write(*,*) 'Runtime parameters are supposed to be in kcm1d.def'
+     stop
+  else
+     call system('touch run.def')
+     call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
+     call system("echo 'INCLUDEDEF=kcm1d.def' >> run.def")
+  endif
+
+  global1d = .false. ! default value
+  call getin("global1d",global1d)
+  if(.not.global1d)then
+     print*,'Error, kcm1d must have global1d=.true. in kcm1d.def!'
+     stop
+  end if
+
+  psurf_n=100000. ! default value for psurf
+  print*,'Dry surface pressure (Pa)?'
+  call getin("psurf",psurf_n)
+  write(*,*) " psurf = ",psurf_n
+
+! OK. now that run.def has been read once -- any variable is in memory.
+! so we can dump the dummy run.def
+  call system("rm -rf run.def")
+
+  tsurf=300.0 ! default value for tsurf
+  print*,'Surface temperature (K)?'
+  call getin("tref",tsurf)
+  write(*,*) " tsurf = ",tsurf
+
+  g=10.0 ! default value for g
+  print*,'Gravity ?'
+  call getin("g",g)
+  write(*,*) " g = ",g
+
+  periastr = 1.0
+  apoastr  = 1.0
+  print*,'Periastron (AU)?'
+  call getin("periastr",periastr)
+  write(*,*) "periastron = ",periastr
+  dist_star = periastr 
+  fract     = 0.5
+  print*,'Apoastron (AU)?'
+  call getin("apoastr",apoastr)
+  write(*,*) "apoastron = ",apoastr
+
+  albedo=0.2 ! default value for albedo
+  print*,'Albedo of bare ground?'
+  call getin("albedo",albedo)
+  write(*,*) " albedo = ",albedo
+
+  emis=1.0 ! default value for emissivity
+  PRINT *,'Emissivity of bare ground ?'
+  call getin("emis",emis)
+  write(*,*) " emis = ",emis
+
+  pceil=100.0 ! Pascals
+  PRINT *,'Ceiling pressure (Pa) ?'
+  call getin("pceil",pceil)
+  write(*,*) " pceil = ", pceil
+
+  mugaz=0.
+  cpp=0.
+
+  check_cpp_match = .false.
+  call getin("check_cpp_match",check_cpp_match)
+  if (check_cpp_match) then
+     print*,"In 1D modeling, check_cpp_match is supposed to be F"
+     print*,"Please correct callphys.def"
+     stop
+  endif
+
+  call su_gases
+  call calc_cpp_mugaz
+
+  call inifis(1,llm,0,86400.0,1.0,0.0,0.0,1.0,rad,g,r,cpp)
+
+  ! Tracer initialisation
+  ! ---------------------
+  if (tracer) then
+     ! load tracer names from file 'traceur.def'
+     open(90,file='traceur.def',status='old',form='formatted',&
+          iostat=ierr)
+     if (ierr.eq.0) then
+        write(*,*) "kcm1d: Reading file traceur.def"
+        ! read number of tracers:
+        read(90,*,iostat=ierr) nq
+        if (ierr.ne.0) then
+           write(*,*) "kcm1d: error reading number of tracers"
+           write(*,*) "   (first line of traceur.def) "
+           stop
+        endif
+        nqtot=nq
+        ! allocate arrays which depend on number of tracers
+        allocate(nametrac(nq))
+        allocate(q(nlayer,nq))
+        allocate(vmr(nlayer,nq))
+        allocate(qsurf(nq))
+
+        do iq=1,nq
+           ! minimal version, just read in the tracer names, 1 per line
+           read(90,*,iostat=ierr) nametrac(iq)
+           if (ierr.ne.0) then
+              write(*,*) 'kcm1d: error reading tracer names...'
+              stop
+           endif
+        enddo !of do iq=1,nq
+     endif
+
+     call initracer(1,nq,nametrac)
+
+  endif
+
+
+  do iq=1,nq
+     do ilay=1,nlayer
+        q(ilay,iq) = 0.
+     enddo
+  enddo
+
+  do iq=1,nq
+     qsurf(iq) = 0.
+  enddo
+
+  firstcall = .true.
+  lastcall  = .false.
+
+  iter    = 1
+  Tstrat  = 150.0
+  dTstrat = 1000.0
+
+  ! ---------
+  ! Run model
+  ! ---------
+  !do
+     psurf = psurf_n
+
+     !    Create vertical profiles
+     call kcmprof_fn(nlayer,psurf,qsurf(1),tsurf,    &
+          tstrat,play,plev,zlay,temp,q(:,1),muvar(1))
+
+     !    Run radiative transfer
+     call callcorrk(1,nlayer,q,nq,qsurf,      &
+          albedo,emis,mu0,plev,play,temp,                    &
+          tsurf,fract,dist_star,aerosol,muvar,         &
+          dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
+          fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,reffrad,nueffrad,tau_col,  &
+          cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
+
+     !    Iterate stratospheric temperature
+     print*,'Tstrat = ',Tstrat
+     dTstrat = Tstrat
+     !Tstrat  = Tsurf*(0.2786*(psurf/100000.)**(-1.123))**0.25 
+     ! skin temperature (gray approx.) using analytic pure H2 expression
+     !Tstrat  = (fluxabs_sw/(2*sigma))**0.25 ! skin temperature (gray approx.)
+     Tstrat  = (fluxtop_lw/(2*sigma))**0.25 ! skin temperature (gray approx.)
+     dTstrat = dTstrat-Tstrat
+
+     !if(abs(dTstrat).lt.1.0)then
+     !   print*,'dTstrat = ',dTstrat
+     !   exit
+     !endif
+
+     !iter=iter+1
+     !if(iter.eq.100)then
+     !   print*,'Stratosphere failed to converge after'
+     !   print*,'100 iteration, aborting run.'
+     !   call abort
+     !endif
+
+  !end do
+
+  ! Run radiative transfer one last time to get OLR,OSR
+  firstcall=.false.
+  lastcall=.true.
+  call callcorrk(1,nlayer,q,nq,qsurf,      &
+       albedo,emis,mu0,plev,play,temp,                    &
+       tsurf,fract,dist_star,aerosol,muvar,         &
+       dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
+       fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,             &
+       reffrad,nueffrad,tau_col,  &
+       cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
+
+
+  ! Calculate total atmospheric energy
+  Eatmtot=0.0
+  !  call calcenergy_kcm(nlayer,tsurf,temp,play,plev,qsurf,&
+  !     q(:,1),muvar,Eatmtot)
+
+  ! ------------------------
+  ! Save data to ascii files
+  ! ------------------------
+
+  print*,'Saving profiles...'
+  open(115,file='profpres.out',form='formatted')
+  open(116,file='proftemp.out',form='formatted')
+  open(117,file='profztab.out',form='formatted')
+  open(118,file='profqvar.out',form='formatted')
+  open(119,file='profvvar.out',form='formatted')
+
+  write(115,*) psurf
+  write(116,*) tsurf
+  write(117,*) 0.0
+  write(118,*) qsurf(1)
+  write(119,*) qsurf(1)*(muvar(1)/mH2O)
+  do ilay=1,nlayer
+     vmr(ilay,1) = q(ilay,1)*(muvar(ilay+1)/mH2O)
+     write(115,*) play(ilay)
+     write(116,*) temp(ilay)
+     write(117,*) zlay(ilay)
+     write(118,*) q(ilay,1)
+     write(119,*) vmr(ilay,1)
+  enddo
+  close(115)
+  close(116)
+  close(117)
+  close(118)
+  close(119)
+
+  print*, tsurf,psurf,fluxtop_dn,fluxabs_sw,fluxtop_lw 
+
+  print*,'Saving scalars...'
+  open(116,file='surf_vals.out')
+  write(116,*) tsurf,psurf,fluxtop_dn,         &
+       fluxabs_sw,fluxtop_lw 
+  close(116)
+  open(111,file='ene_vals.out')
+  write(111,*) tsurf,psurf,Eatmtot,Tstrat
+  close(111)
+
+  print*,'Saving spectra...'
+  open(117,file='OLRnu.out')
+  do iw=1,L_NSPECTI
+     write(117,*) OLR_nu(1,iw)
+  enddo
+  close(117)
+
+  open(127,file='OSRnu.out')
+  do iw=1,L_NSPECTV
+     write(127,*) OSR_nu(1,iw)
+  enddo
+  close(127)  
+
+end program kcm1d
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcmprof_fn.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcmprof_fn.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/kcmprof_fn.F90	(revision 1403)
@@ -0,0 +1,389 @@
+subroutine kcmprof_fn(nlayer,psurf_rcm,qsurf_rcm,Tsurf_rcm,Tstra_rcm,P_rcm,Pl_rcm,z_rcm,T_rcm,q_rcm,m_rcm)
+
+use params_h
+use watercommon_h, only : mH2O
+use gases_h
+use comcstfi_mod, only: mugaz, cpp, g
+use callkeys_mod, only: co2cond
+implicit none
+
+!     ----------------------------------------------------------------
+!     Purpose: create profiles of T, rho_v, rho_n, Pv and Pn following 
+!              Kasting 1988
+!     Authour: Adapted from a code by E. Marcq by R. Wordsworth (2011)
+!     ----------------------------------------------------------------
+
+  integer ilay, nlay
+  parameter (nlay=10000) ! number of vertical layers
+
+  ! rcm inputs
+  integer nlayer
+  real Tsurf_rcm,Tstra_rcm
+
+  ! rcm outputs
+  real psurf_rcm,qsurf_rcm
+  real P_rcm(1:nlayer)
+  real Pl_rcm(1:nlayer+1)
+  real z_rcm(1:nlayer)
+  real T_rcm(1:nlayer),q_rcm(1:nlayer)
+  real m_rcm(1:nlayer+1)
+
+  ! rcm for interpolation (should really use log coords?)
+  !double precision p1,p2,pnew,ilay_rcm
+
+  double precision lnp1,lnp2,lnpnew
+  real Dp_rcm, dlogp_rcm
+  integer ilay_rcm,ilev_rcm,ifinal_rcm
+
+  double precision Dz, Dp
+  double precision Ptop, dlogp, Psat_max
+  parameter (Ptop=1.0)                             ! Pressure at TOA [Pa]
+
+  double precision T(1:nlay)                       ! temperature [K]
+  double precision Ztab(1:nlay)                    ! altitude [m]
+  double precision Pv(1:nlay),Pn(1:nlay),P(1:nlay) ! pressure [Pa]
+  double precision rho_v(1:nlay), rho_n(1:nlay)    ! density [kg m^-3]
+  double precision a_v(1:nlay)                     ! = rho_v/rho_n [kg/kg]
+  double precision q_v(1:nlay)                     ! = rho_v/rho_tot [kg/kg]
+  double precision mtot(1:nlay)                    ! = (rho_v+rho_n)/(n_v+n_n) [g/mol]
+
+  integer profil_flag(1:nlay) ! 0 = dry, 1 = moist, 2 = isothermal
+
+  ! inputs
+  double precision Tsurf   ! surface temperature [K]
+  double precision Psurf_v ! surface par. pressure (variable species) [Pa]
+  double precision Psurf_n ! surface par. pressure (incondensible species)[Pa]
+  double precision Ttop    ! stratospheric temperature [K]
+
+  double precision dTdp        ! [K/Pa]
+  double precision dPvdp,dPndp ! [Pa/Pa]
+  double precision psat_v      ! local Psat_H2O value
+  double precision Tcrit       ! Critical temperature [K]
+  double precision rho_vTEMP,rho_nTEMP
+
+  double precision TCO2cond ! for CO2 condensation quasi-hack
+
+  ! variables necessary for steam.f90
+  double precision rhol,rhov,nul
+
+  ! for output
+  double precision vmr
+
+  logical verbose
+  parameter(verbose=.true.)
+
+  logical add_Pvar_to_total
+  parameter(add_Pvar_to_total=.true.)
+
+  ! initialise flags
+  profil_flag(:) = 0
+
+  !-------------------------------
+  ! assign input variables
+  m_n     = dble(mugaz/1000.)
+  cp_n    = cpp
+  ! modify/generalise later??
+
+  Psat_max = 1000000.0 ! maximum vapour pressure [Pa]
+                       ! set huge until further notice 
+
+  if(vgas.lt.1)then
+     if(psat_max.gt.0.0)then
+        print*,'Must have Psat_max=0 if no variable species'
+        psat_max=0.0
+        !stop
+     endif
+     print*, 'Assuming pure atmosphere'
+     m_v   = 1.0
+     tcrit = 1000.0
+  elseif(trim(gnom(vgas)).eq.'H2O')then
+     m_v   = dble(mH2O/1000.)
+     tcrit = 6.47d2
+  elseif(trim(gnom(vgas)).eq.'NH3')then
+     m_v   = 17.031/1000.
+     tcrit = 4.06d2
+  elseif(trim(gnom(vgas)).eq.'CH4')then
+     m_v   = 16.04/1000.
+     tcrit = 1.91d2
+     stop
+  else
+     print*,'Variable gas not recognised!'
+     call abort
+  endif
+
+  rmn     = rc/m_n
+  Ttop    = dble(Tstra_rcm)
+  Tsurf   = dble(Tsurf_rcm)
+
+  psat_v  = psat_max
+  if(vgas.gt.0)then
+     if(trim(gnom(vgas)).eq.'H2O')then
+        call Psat_H2O(tsurf,psat_v)
+     elseif(trim(gnom(vgas)).eq.'NH3')then
+        call Psat_NH3(tsurf,psat_v)
+     endif
+  endif
+
+  ! Moist adiabat unless greater than or equal to psat_max
+  if(psat_v*1d6.lt.psat_max)then
+    Psurf_v = Psat_v*1d6
+    profil_flag(1) = 1
+  else 
+    Psurf_v = psat_max
+    profil_flag(1) = 0
+  endif
+
+  if(add_Pvar_to_total)then
+    Psurf_n = dble(psurf_rcm)
+    psurf_rcm = real(Psurf_n+Psurf_v)
+  else
+    Psurf_n = dble(psurf_rcm) - Psurf_v
+  endif
+
+  ! include relative humidity option
+  !if(satval.lt.1.0)then
+  !   Psurf_v = Psurf_v*satval
+  !   profil_flag(1) = 0     
+  !endif
+
+  if(verbose)then
+     print*,'Psat_v  =',psat_v*1d6
+     print*,'Tsurf   =',Tsurf,' K'
+     print*,'Ttop    =',Ttop,' K'
+     print*,'Psurf_v =',Psurf_v,' Pa'
+     print*,'Psurf_n =',Psurf_n,' Pa'
+     print*,'m_n     =',m_n,' kg/mol'
+     print*,'m_v     =',m_v,' kg/mol'
+     print*,'rc      =',rc
+  endif
+
+  ! define fine pressure grid
+  dlogp_rcm = -(log(psurf_rcm)-log(ptop))/nlayer
+
+  P_rcm(1)  = psurf_rcm*exp(dlogp_rcm)
+  do ilay_rcm=1,nlayer-1
+     P_rcm(ilay_rcm+1) = P_rcm(ilay_rcm)*exp(dlogp_rcm)
+  enddo
+
+  Pl_rcm(1) = psurf_rcm
+  do ilev_rcm=2,nlayer
+     ! log-linear interpolation
+     Pl_rcm(ilev_rcm) = exp( log( P_rcm(ilev_rcm)*P_rcm(ilev_rcm-1) )/2 )
+  enddo
+
+  !-------------------------------
+  ! Layer 1
+  T(1)     = Tsurf
+  Pv(1)    = Psurf_v
+  Pn(1)    = Psurf_n
+  rho_n(1) = m_n*Pn(1)/(Rc*Tsurf)
+  rho_v(1) = m_v*Pv(1)/(Rc*Tsurf)
+  a_v(1)   = rho_v(1)/rho_n(1)
+
+  ! log pressure grid spacing (constant)
+  dlogp = -(log(Pn(1)+Pv(1))-log(ptop))/(nlay-1)
+
+  call gradients_kcm(profil_flag(1),rho_v(1),rho_n(1),Tsurf,dTdp,dPvdp,dPndp)
+  if(verbose)then
+     print*, 'dT/dp ground [K/Pa] =',dTdp
+  endif
+
+  ! initial delta p, delta z
+  Dp = (Pn(1) + Pv(1))*(exp(dlogp) - 1d0)
+  Dz = -Dp/(  g*(rho_n(1) + rho_v(1))  )
+
+  !-------------------------------
+  ! Layer 2
+  T(2)     = tsurf + dTdp*Dp 
+  Pv(2)    = Pv(1) + dPvdp*Dp
+  Pn(2)    = Pn(1) + dPndp*Dp
+  rho_n(2) = m_n*Pn(2)/(Rc*T(2))
+  rho_v(2) = m_v*Pv(2)/(Rc*T(2))
+  a_v(2)   = rho_v(2)/rho_n(2)
+
+  !-------------------------------
+  ! start vertical ascent
+  Ztab(1) = 0.
+  do ilay=2,nlay-1
+
+     ! calculate altitude levels (for diagnostic only)
+     Dz         = -Dp/(  g*(rho_n(ilay) + rho_v(ilay))  )
+     Ztab(ilay) = Dz + Ztab(ilay-1)
+
+     ! 1st assume next layer same as last one
+     profil_flag(ilay) = profil_flag(ilay-1)
+  
+     ! update delta p
+     Dp = (Pn(ilay)+Pv(ilay))*(exp(dlogp) - 1d0)
+
+     ! intial gradients call to calculate temperature at next level
+     call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
+                        T(ilay),dTdp,dPvdp,dPndp)
+
+     T(ilay+1) = T(ilay) + dTdp*Dp
+
+     ! test for moist adiabat at next level
+     psat_v=psat_max
+
+     if(vgas.gt.0)then
+     if(trim(gnom(vgas)).eq.'H2O')then
+        call Psat_H2O(T(ilay+1),psat_v)
+     elseif(trim(gnom(vgas)).eq.'NH3')then
+        call Psat_NH3(T(ilay+1),psat_v)
+     endif
+     endif
+
+     if (psat_v*1d6 .lt. Pv(ilay)+dPvdp*Dp) then
+        profil_flag(ilay)=1
+        call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
+                         T(ilay),dTdp,dPvdp,dPndp)
+     endif
+
+     ! test for stratosphere at next level
+     if (T(ilay+1) .le. Ttop) then
+        profil_flag(ilay)=2
+        T(ilay+1)=Ttop
+     endif
+
+     ! calculate pressures at next level
+     Pn(ilay+1) = Pn(ilay) + dPndp*Dp
+     Pv(ilay+1) = Pv(ilay) + dPvdp*Dp
+
+     if(profil_flag(ilay) .eq. 1)then
+       
+        psat_v=psat_max 
+
+        if(vgas.gt.0)then
+        if(trim(gnom(vgas)).eq.'H2O')then
+           call Psat_H2O(T(ilay+1),psat_v)
+        elseif(trim(gnom(vgas)).eq.'NH3')then
+           call Psat_NH3(T(ilay+1),psat_v)
+        endif
+        endif
+
+        if(Pv(ilay+1) .lt. psat_v*1e6)then
+           Pv(ilay+1)=psat_v*1d6
+        endif
+
+     endif
+
+     ! calculate gas densities at next level (assume ideal)
+     rho_n(ilay+1) = m_n*Pn(ilay+1)/(rc*T(ilay+1)) 
+     select case(profil_flag(ilay)) 
+     case(2) ! isothermal
+        rho_v(ilay+1) = rho_v(ilay)/rho_n(ilay)*rho_n(ilay+1)
+     case(1) ! moist
+
+        ! dont think this is necessary
+        !call psat_est(T(ilay+1),psat_v)
+        ! modify for ammonia!!!
+
+        rho_v(ilay+1) = m_v*psat_v*1d6/(rc*T(ilay+1))
+     case(0) ! dry
+        rho_v(ilay+1) = m_v*Pv(ilay+1)/(rc*T(ilay+1)) 
+     end select
+
+  enddo
+
+  Ztab(nlay)=Ztab(nlay-1)+Dz
+
+  !-------------------------------
+  ! save to kcm1d variables 
+
+  ! surface quantities
+  psurf_rcm = Pn(1) + Pv(1)
+  qsurf_rcm = rho_v(1)/(rho_v(1) + rho_n(1))
+
+  ! create q_v, mtot for saving
+  do ilay=1,nlay
+     mtot(ilay) = 1d3*(rho_v(ilay) + rho_n(ilay)) / &
+                  (rho_v(ilay)/m_v + rho_n(ilay)/m_n)
+     q_v(ilay)  = rho_v(ilay)/(rho_v(ilay) + rho_n(ilay))
+     ! CHECK THIS
+  enddo
+
+
+  ! convert to rcm lower-res grid
+  z_rcm(:) = 0.0
+  T_rcm(:) = 0.0
+  q_rcm(:) = 0.0
+  m_rcm(:) = 0.0
+
+  m_rcm(1) = real( 1d3*(rho_v(1) + rho_n(1)) / &
+                  (rho_v(1)/m_v + rho_n(1)/m_n) )
+
+  ilay_rcm=1
+  do ilay=2,nlay
+
+     if(ilay_rcm.le.nlayer)then
+     ! interpolate rcm variables
+
+        if(Pn(ilay)+Pv(ilay) .lt. P_rcm(ilay_rcm))then
+
+           if(ilay.eq.1)then
+              print*,'Error in create_profils: Psurf here less than Psurf in RCM!'
+              call abort
+           endif
+
+           lnp1   = log(Pn(ilay-1)+Pv(ilay-1))
+           lnp2   = log(Pn(ilay)+Pv(ilay))
+           lnpnew = dble(log(P_rcm(ilay_rcm)))
+
+           z_rcm(ilay_rcm) = real(Ztab(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + Ztab(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+           T_rcm(ilay_rcm) = real(T(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + T(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+           q_rcm(ilay_rcm) = real(q_v(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + q_v(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+
+           m_rcm(ilay_rcm+1) = real(mtot(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
+                             + mtot(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
+
+           ilay_rcm = ilay_rcm+1
+        endif
+
+     endif
+  enddo
+
+  ifinal_rcm=ilay_rcm-1
+  if(ifinal_rcm.lt.nlayer)then
+     if(verbose)then
+        print*,'Interpolation in kcmprof stopped at layer',ilay_rcm,'!'
+     endif
+
+     do ilay_rcm=ifinal_rcm+1,nlayer
+
+        z_rcm(ilay_rcm) = z_rcm(ilay_rcm-1)
+        T_rcm(ilay_rcm) = T_rcm(ilay_rcm-1)
+        q_rcm(ilay_rcm) = q_rcm(ilay_rcm-1)
+        m_rcm(ilay_rcm+1) = m_rcm(ilay_rcm)
+
+     enddo
+  endif
+
+  do ilay=2,nlayer
+     if(T_rcm(ilay).lt.Ttop)then
+        T_rcm(ilay)=Ttop
+     endif
+  enddo
+
+!    CO2 condensation 'haircut' of temperature profile if necessary
+  if(co2cond)then
+     print*,'CO2 condensation haircut - assumes CO2-dominated atmosphere!'
+     do ilay=2,nlayer
+        if(P_rcm(ilay).lt.518000.)then
+           TCO2cond = (-3167.8)/(log(.01*P_rcm(ilay))-23.23) ! Fanale's formula
+        else
+           TCO2cond = 684.2-92.3*log(P_rcm(ilay))+4.32*log(P_rcm(ilay))**2 
+           ! liquid-vapour transition (based on CRC handbook 2003 data)
+        endif
+
+        print*,'p=',P_rcm(ilay),', T=',T_rcm(ilay),' Tcond=',TCO2cond
+        if(T_rcm(ilay).lt.TCO2cond)then
+           T_rcm(ilay)=TCO2cond
+        endif
+     enddo
+  endif
+
+  return
+end subroutine kcmprof_fn
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/logic.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/logic.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/logic.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/logic.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_const_mpi.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_const_mpi.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_const_mpi.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/mod_const_mpi.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_para.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/paramet.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/paramet.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/paramet.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/paramet.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/phasechange_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/phasechange_kcm.F90	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/phasechange_kcm.F90	(revision 1403)
@@ -0,0 +1,1286 @@
+!  ----------------------------------------------------------------
+!  Purpose: Thermodynamic data on H2O, NH3
+!  Authour: Adapted from various sources by R. Wordsworth (2011)
+
+
+! ---------------------
+! NH3
+! ---------------------
+subroutine psat_NH3 ( T, p )
+!
+!  PSAT_NH3 makes a rough estimate of the vapor pressure.
+!
+!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
+!  temperatures between 223 and 323 K.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision P, the vapor pressure, in MegaPascals.
+!
+
+  implicit none
+
+  double precision p,T
+
+  p=exp(-1.5609d-004*T**2 + 0.1236*T - 9.1530)/1d6
+
+end subroutine psat_NH3
+
+subroutine latheat_NH3 ( T, sc, sv )
+!
+!  PSAT_NH3 makes a rough estimate of the entropies of condensation /
+!  vapourisation.
+! 
+!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
+!  temperatures between 223 and 323 K.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision sc, the entropy of condensate, in J kg^-1 K^-1.
+!            double precision sv, the entropy of gas, in J kg^-1 K^-1.
+!
+
+  implicit none
+
+  double precision T,sc,sv
+
+  sv = 0.0492*T**2 - 40.4199*T + 1.2708e+004
+  sc = -0.0215*T**2 + 28.7138*T - 5.5267e+003
+
+  !L = -11.2373*T**2 + 2.5326d+03*T + 1.4099d+06
+
+end subroutine latheat_NH3
+
+
+! ---------------------
+! H2O
+! ---------------------
+
+subroutine base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
+!
+!*******************************************************************************
+!
+!! BASE calculates quantities associated with the base Helmholtz function.
+!
+!
+!  Discussion:
+!
+!    The equation for the base Helmholtz function AB(T,RHO) is:
+!
+!      AB(T,RHO) = R * T * (
+!        - ln ( 1 - y ) 
+!        - ( beta - 1 ) / ( 1 - y ) 
+!        + ( alpha + beta + 1 ) / ( 2 * ( 1 - y )**2 )
+!        + 4 * y * ( ( Bbar / b ) - gamma ) 
+!        - 0.5 * ( alpha - beta + 3 ) 
+!        + ln ( RHO * R * T / P0 ) )
+!                                                      (Equation 2)
+!   where 
+!
+!     y = b * rho / 4, 
+!     alpha = 11,
+!     beta = 133/3, 
+!     gamma = 7/2, 
+!     P0 = 0.101325 MegaPascals = 1 atm
+!
+!   and
+!
+!     b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
+!
+!     Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
+!
+!   where 
+!
+!     T0=647.073 K and the coefficients b(j) and B(j) are
+!    
+!     j    b(j)                         B(j)
+!    --    -----------                  ----------
+!     0    0.7478629                    1.1278334
+!     1   -0.3540782                   -0.5944001
+!     2    0                           -5.010996
+!     3    0.007159876                  0
+!     4    0                            0.63684256
+!     5   -0.003528426                  0
+!
+!  For the derived quantities, the following relations are used:
+!
+!    Pressure:                  PB      = RHO**2 * dAB/dRHO
+!    Density derivative:        DPDRB   = 2*PB/RHO + RHO**2 * d2AB/dRHO2
+!    Temperature derivative:    DPDTB   = RHO**2 * d2AB/(dRHO dT)
+!    Specific entropy:          SB      = ( UB - AB ) / T
+!    Specific internal energy:  UB      = AB + T * SB
+!    Specific enthalpy:         HB      = UB + PB / RHO
+!    Specific heat capacity
+!      at constant volume:      CVB     = - T * d2AB/dT2
+!    Specific Gibbs function:   GB      = AB + PB / RHO
+!
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Modified:
+!
+!    03 February 2002
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the density, in G/CM3.
+!
+!    Output, double precision AB, the base value of the Helmholtz function,
+!    in KJ/kg.
+!
+!    Output, double precision CVB, the base value of the isochoric (constant 
+!    volume) heat capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDRB, the base value of the partial
+!    derivative dP(T,RHO)/dRHO, with T held fixed, in (MegaPascals CM3)/G.
+!
+!    Output, double precision DPDTB, the base value of the partial
+!    derivative dP(T,RHO)/dT, with RHO held fixed, in 
+!    MegaPascals/degrees Kelvin.
+!
+!    Output, double precision GB, the base value of the Gibbs free energy,
+!    in KJ/kg.
+!
+!    Output, double precision HB, the base value of enthalpy, in KJ/kg.
+!
+!    Output, double precision PB, the base pressure, in MegaPascals.
+!
+!    Output, double precision SB, the base value of entropy, 
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UB, the base value of internal energy, 
+!    in KJ/kg.
+!
+  implicit none
+!
+  double precision ab
+  double precision, parameter :: alpha = 11.0D+00
+  double precision b1
+  double precision b1t
+  double precision b1tt
+  double precision b2
+  double precision b2t
+  double precision b2tt
+  double precision, parameter :: beta = 44.333333333333D+00
+  double precision cvb
+  double precision dpdrb
+  double precision dpdtb
+  double precision dz
+  double precision dz0
+  double precision, parameter :: gamma = 3.5D+00
+  double precision gascon
+  double precision gb
+  double precision hb
+  double precision, parameter :: p_zero = 0.101325D+00
+  double precision pb
+  double precision rho
+  double precision sb
+  double precision t
+  double precision ub
+  double precision x
+  double precision y
+  double precision z
+  double precision z0
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BASE - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BASE - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+!
+!  Compute auxilliary quantities for Equation 2.
+!
+  call bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
+
+  y = 0.25D+00 * b1 * rho
+
+  x = 1.0D+00 - y
+!
+!  Evaluate Equation 2.
+!
+  ab =   - log ( 1.0D+00 - y ) &
+         - ( beta - 1.0D+00 ) / ( 1.0D+00 - y ) &
+         + ( alpha + beta + 1.0D+00 ) / ( 2.0D+00 * ( 1.0D+00 - y )**2 ) &
+         + 4.0D+00 * y * ( ( b2 / b1 ) - gamma ) &
+         - 0.5D+00 * ( alpha - beta + 3.0D+00 ) &
+         + log ( rho * gascon() * t / p_zero )
+!
+!  Determine quantities defined in terms of AB.
+!
+  pb = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3 &
+    + 4.0D+00 * y * ( b2 / b1 - gamma )
+
+  z0 = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3
+
+  z = z0 + 4.0D+00 * y * ( b2 / b1 - gamma )
+
+  dz0 = ( alpha + 2.0D+00 * beta * y ) / ( 1.0D+00 - y )**3 &
+    + 3.0D+00 * ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**4
+
+  dz = dz0 + 4.0D+00 * ( b2 / b1 - gamma )
+
+  gb = ab + pb
+
+  ub = - t * b1t * ( pb - 1.0D+00 - rho * b2 ) / b1 - rho * t * b2t
+
+  hb = pb + ub
+!
+!  An incorrect version of this equation began:
+!
+!    cvb = 2.0D+00 * ub + ( pb - 1.0D+00 ) &
+!
+!  and caused me no end of trouble.  My fault, JVB, 03 February 2002
+!
+  cvb = 2.0D+00 * ub + ( z0 - 1.0D+00 ) &
+    * ( ( t * b1t / b1 )**2 - t**2 * b1tt / b1 ) &
+    - rho * t**2 * ( b2tt - gamma * b1tt ) - ( t * b1t / b1 )**2 * y * dz0
+
+  dpdtb = pb / t + rho * ( 0.25D+00 * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) ) &
+    * b1t + b2t - b2 / b1 * b1t )
+
+  sb = ub - ab
+
+  dpdrb = pb + y * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) )
+!
+!  Assign dimensions.
+!
+  ab =    gascon() * t       * ab
+  cvb =   gascon()           * cvb
+  dpdrb = gascon() * t       * dpdrb
+  dpdtb = gascon() * t * rho * dpdtb
+  gb =    gascon() * t       * gb
+  hb =    gascon() * t       * hb
+  pb =    gascon() * t * rho * pb
+  sb =    gascon()           * sb
+  ub =    gascon() * t       * ub
+
+  return
+end subroutine base
+
+subroutine bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
+!
+!*******************************************************************************
+!
+!! BB calculates the B's of equations 3 and 4.  
+!
+!
+!  Discussion:
+!
+!    Here
+!
+!      b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
+!
+!      Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
+!
+!    where 
+!
+!      T0 = 647.073 K 
+!
+!    and the coefficients b(j) and B(j) are
+!    
+!      j    b(j)                         B(j)
+!     --    -----------                  ----------
+!      0    0.7478629                    1.1278334
+!      1   -0.3540782                   -0.5944001
+!      2    0                           -5.010996
+!      3    0.007159876                  0
+!      4    0                            0.63684256
+!      5   -0.003528426                  0
+!
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision B1, the coefficient b from equation 3, 
+!    in CM3/G.
+!
+!    Output, double precision B2, the coefficient Bbar from equation 4, 
+!    in CM3/G.
+!
+!    Output, double precision B1T, the derivative dB1/dT, 
+!    in (CM3)/(G Degrees Kelvin).
+!
+!    Output, double precision B2T, the derivative dB2/dT, 
+!    in (CM3)/(G Degrees Kelvin).
+!
+!    Output, double precision B1TT, the second derivative of B1 with 
+!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
+!
+!    Output, double precision B2TT, the second derivative of B2 with 
+!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
+!
+  implicit none
+!
+  double precision b1
+  double precision b1t
+  double precision b1tt
+  double precision b2
+  double precision b2t
+  double precision b2tt
+  double precision, parameter, dimension ( 10 ) :: bp = (/ &
+    0.7478629D+00,   -0.3540782D+00,    0.0D+00,           0.0D+00, &
+    0.007159876D+00,  0.0D+00,         -0.003528426D+00,   0.0D+00, &
+    0.0D+00,          0.0D+00 /)
+  double precision, parameter, dimension ( 10 ) :: bq = (/ &
+    1.1278334D+00,    0.0D+00,         -0.5944001D+00,   -5.010996D+00, &
+    0.0D+00,          0.63684256D+00,   0.0D+00,          0.0D+00, &
+    0.0D+00,          0.0D+00 /)
+  integer i
+  double precision t
+  double precision, parameter :: t_ref = 647.073D+00
+  double precision v(10)
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'BB - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Set V(I) = ( T_REF / T )**(I-1).
+!
+  v(1) = 1.0D+00
+  do i = 2, 10
+    v(i) = v(i-1) * t_ref / t
+  end do
+!
+!  Set B1, B1T, B1TT.
+!
+  b1 = bp(1) + bp(2) * log ( 1.0D+00 / v(2) )
+  b1t = bp(2) * v(2) / t_ref
+  b1tt = 0.0D+00
+  do i = 3, 10
+    b1 = b1 + bp(i) * v(i-1)
+    b1t = b1t - dble ( i - 2 ) * bp(i) * v(i-1) / t
+    b1tt = b1tt + bp(i) * dble ( i - 2 )**2 * v(i-1) / t**2
+  end do
+
+  b1tt = b1tt -  ( b1t / t )
+!
+!  Set B2, B2T, B2TT.
+!
+  b2 = bq(1)
+  b2t = 0.0D+00
+  b2tt = 0.0D+00
+  do i = 3, 10
+    b2 = b2 + bq(i) * v(i-1)
+    b2t = b2t - dble ( i - 2 ) * bq(i) * v(i-1) / t
+    b2tt = b2tt + bq(i) * dble ( i - 2 )**2 * v(i-1) / t**2
+  end do
+
+  b2tt = b2tt - ( b2t / t )
+
+  return
+end subroutine bb
+
+
+subroutine ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
+!
+!*******************************************************************************
+!
+!! IDEAL computes ideal gas thermodynamic properties of water.
+!
+!
+!  Discussion:
+!
+!    Values for thermodynamic properties of water in the ideal
+!    gas state were reported by Woolley.  The formula for the ideal gas
+!    term of the Helmholtz function approximates a term by term summation of 
+!    contributions from each of the rotation and vibration states.  
+!    The formula, equation #6 in the reference, is:
+!   
+!    A(ideal)(T) = -R * T * ( 1 + ( C(1)/Tr + C(2) ) * ln(Tr)
+!      + Sum ( 3 <= I <= 18) C(I) * Tr**(I-6)
+!   
+!    where Tr=T/100 K.  The C(i) are tabulated coefficients.  Equation
+!    6 can be used for temperatures below 3000 K, and is accurate to
+!    within the tolerance of the gas constant for 50<=T<=2000 K.
+!     
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision AI, the Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CPI, the heat capacity at constant pressure,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision CVI, the heat capacity at constant volume,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision GI, the Gibbs free energy, in KJ/kg.
+!
+!    Output, double precision HI, the enthalpy, in KJ/kg.
+!
+!    Output, double precision SI, the entropy, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UI, the internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision ai
+  double precision, parameter, dimension ( 18 ) :: c = (/ &
+   19.730271018D+00,      20.9662681977D+00,     -0.483429455355D+00, &
+    6.05743189245D+00,    22.56023885D+00,       -9.87532442D+00, &
+   -4.3135538513D+00,      0.458155781D+00,      -0.047754901883D+00, &
+    0.0041238460633D+00,  -0.00027929052852D+00,  0.14481695261D-04, &
+   -0.56473658748D-06,     0.16200446D-07,       -0.3303822796D-09, &
+    0.451916067368D-11,   -0.370734122708D-13,    0.137546068238D-15 /)
+  double precision cpi
+  double precision cvi
+  double precision gascon
+  double precision gi
+  double precision hi
+  integer i
+  double precision si
+  double precision t
+  double precision temp
+  double precision tt
+  double precision ui
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'IDEAL - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  tt = t / 100.0D+00
+
+  gi = - ( c(1) / tt + c(2) ) * log ( tt )
+  do i = 3, 18
+    gi = gi - c(i) * tt**(i-6)
+  end do
+
+  hi = c(2) + c(1) * ( 1.0D+00 - log ( tt ) ) / tt
+  do i = 3, 18
+    hi = hi + dble ( i - 6 ) * c(i) * tt**(i-6)
+  end do
+
+  cpi = c(2) - c(1) / tt
+  do i = 3, 18
+    cpi = cpi + dble ( ( i - 6 ) * ( i - 5 ) ) * c(i) * tt**(i-6)
+  end do
+
+  ai = gi - 1.0D+00
+  ui = hi - 1.0D+00
+  cvi = cpi - 1.0D+00
+  si = hi - gi
+!
+!  Assign dimensions.
+!
+  ai =  gascon() * t * ai
+  cpi = gascon()     * cpi
+  cvi = gascon()     * cvi
+  gi =  gascon() * t * gi
+  hi =  gascon() * t * hi
+  si =  gascon()     * si
+  ui =  gascon() * t * ui
+
+  return
+end subroutine ideal
+
+
+subroutine resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
+!
+!*******************************************************************************
+!
+!! RESID calculates residual contributions to thermodynamic quantities.
+!
+!
+!  Discussion:
+!
+!    The residual function consists of 40 terms.  The first 36 are
+!    used in a global least squares fit to experimental data.
+!
+!    Three terms were added that contribute only in the immediate
+!    neighborhood of the critical point 
+!      (tk-5) <= T <= (tk+5) C
+!      0.20   <= rho <= 0.44 g/cm3, 
+!
+!    A single term was added for the region of high pressure and 
+!    low temperature: T < 75 C, P > 300 MPa.
+!
+!    Except in these limited regions, the residual function is
+!    given by the first 36 terms.  The equation is
+!   
+!      A(residual)(rho,T)=
+!        sum(i=1 to 36) (g(i)/k(i)) * (T0/T)**(l(i)) (1-exp(-rho))**(k(i))
+!      + sum(i=37 to 40) g(i)*delta(i)**(k(i))
+!        * exp(-alpha(i)*delta(i)**(k(i)) - beta(i)*tau(i)**2)
+!                                                     (Equation 5)
+!   
+!    where
+!
+!      g(i) are coefficients determined by fits to data,
+!      delta(i) are reduced densities (delta(i)=((rho-rho(i))/rho(i))
+!      tau(i) are reduced temperatures (tau(i)=((T-tau(i))/tau(i))
+!      rho(i) are specified densities.
+!      tau(i) are specified temperatures.
+!      The k(i) and l(i) are specified integers.
+!   
+!  Modified:
+!
+!    22 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the density, in G/CM3.
+!
+!    Output, double precision AR, the residual contribution to the 
+!    Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CVR, the residual contribution to the 
+!    isochoric (constant volume) heat capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDRR, the residual contribution to 
+!    the partial derivative dP(T,RHO)/dRHO, with T held fixed, in 
+!    (MegaPascals CM3)/G.
+!
+!    Output, double precision DPDTR, the residual contribution to 
+!    the partial derivative dP(T,RHO)/dT, with RHO held fixed, 
+!    in MegaPascals/degrees Kelvin.
+!
+!    Output, double precision GR, the residual contribution to the Gibbs 
+!    function, in KJ/kg.
+!
+!    Output, double precision HR, the residual contribution to the 
+!    enthalpy, in KJ/kg.
+!
+!    Output, double precision PR, the residual contribution to the pressure, 
+!    in MegaPascals.
+!
+!    Output, double precision SR, the residual contribution to the entropy, 
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision UR, the residual contribution to the 
+!    internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 4 ) :: aad = (/ &
+    34.0D+00, 40.0D+00, 30.0D+00, 1050.0D+00 /)
+  double precision, parameter, dimension ( 4 ) :: aat = (/ &
+    20000.0D+00, 20000.0D+00, 40000.0D+00, 25.0D+00 /)
+  double precision, parameter, dimension ( 4 ) :: adz = (/ &
+    0.319D+00, 0.319D+00, 0.319D+00, 1.55D+00 /)
+  double precision ar
+  double precision att
+  double precision, parameter, dimension ( 4 ) ::  atz = (/ &
+    640.0D+00, 640.0D+00, 641.6D+00, 270.0D+00 /)
+  double precision cvr
+  double precision dadt
+  double precision ddz
+  double precision del
+  double precision dex
+  double precision dfdt
+  double precision dpdrr
+  double precision dpdtr
+  double precision e
+  double precision errtol
+  double precision ex0
+  double precision ex1
+  double precision ex2
+  double precision fct
+  double precision, parameter, dimension ( 40 ) :: g = (/ &
+    -530.62968529023D+00,  0.22744901424408D+04, 0.78779333020687D+03, &
+    -69.830527374994D+00,  0.17863832875422D+05,-0.39514731563338D+05, &
+    0.33803884280753D+05, -0.13855050202703D+05,-0.25637436613260D+06, &
+    0.48212575981415D+06, -0.34183016969660D+06, 0.12223156417448D+06, &
+    0.11797433655832D+07, -0.21734810110373D+07, 0.10829952168620D+07, &
+   -0.25441998064049D+06, -0.31377774947767D+07, 0.52911910757704D+07, &
+   -0.13802577177877D+07, -0.25109914369001D+06, 0.46561826115608D+07, &
+   -0.72752773275387D+07,  0.41774246148294D+06, 0.14016358244614D+07, &
+   -0.31555231392127D+07,  0.47929666384584D+07, 0.40912664781209D+06, &
+   -0.13626369388386D+07,  0.69625220862664D+06,-0.10834900096447D+07, &
+   -0.22722827401688D+06,  0.38365486000660D+06, 0.68833257944332D+04, &
+    0.21757245522644D+05, -0.26627944829770D+04,-0.70730418082074D+05, &
+   -0.225D+00, -1.68D+00, 0.055D+00, -93.0D+00 /)
+  double precision gascon
+  double precision gr
+  double precision hr
+  integer i
+  integer, parameter, dimension ( 40 ) :: ii = (/ &
+    0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6, &
+    8,8,8,8,2,2,0,4,2,2,2,4 /)
+  integer j
+  integer, parameter, dimension ( 40 ) :: jj = (/ &
+    2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,&
+    2,3,5,7,1,4,4,4,0,2,0,0 /)
+  integer k
+  integer l
+  integer nc
+  double precision pr
+  double precision q10
+  double precision q20
+  double precision q2a
+  double precision q5t
+  double precision qm
+  double precision qp
+  double precision qr(11)
+  double precision qt(10)
+  double precision rho
+  double precision sr
+  double precision, parameter :: s_ref = 7.6180720166752D+00
+  double precision t
+  double precision, parameter :: t_ref = 647.073D+00
+  double precision tau
+  double precision tx
+  double precision, parameter :: u_ref = - 4328.4549774261D+00
+  double precision ur
+  double precision v
+!
+  errtol = sqrt ( epsilon ( errtol ) )
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'RESID - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'RESID - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+
+  nc = 36
+  dpdrr = 0.0D+00
+  pr = 0.0D+00
+  ar = 0.0D+00
+  dadt = 0.0D+00
+  cvr = 0.0D+00
+  dpdtr = 0.0D+00
+
+  ex0 = - rho
+! ex0 = max ( ex0, - 225.0D+00 )
+! ex0 = min ( ex0, 225.0D+00 )
+  e = exp ( ex0 )
+
+  q10 = rho * rho * e
+  q20 = 1.0D+00 - e
+
+  qr(1) = 0.0D+00
+  qr(2) = q10
+  do i = 2, 10
+    qr(i+1) = qr(i) * q20
+  end do
+
+  v = t_ref / t
+  qt(1) = t / t_ref
+  do i = 2, 10
+    qt(i) = qt(i-1) * v
+  end do
+
+  do i = 1, nc
+
+    k = ii(i) + 1
+    l = jj(i)
+    qp = g(i) * qr(k+1) * qt(l+1)
+    pr = pr + qp
+
+    dpdrr = dpdrr + ( 2.0D+00 / rho - ( 1.0D+00 - e * dble ( k - 1 ) / &
+      ( 1.0D+00 - e ) ) ) * qp
+
+    ar = ar + g(i) * qr(k+2) * qt(l+1) / ( rho**2 * e * dble ( k ) &
+      * gascon ( ) * t )
+
+    dfdt = ( 1.0D+00 - e )**k * dble ( 1 - l ) * qt(l+2) / t_ref / dble ( k )
+
+    dadt = dadt + g(i) * dfdt
+
+    dpdtr = dpdtr + g(i) * dfdt * rho**2 * e * dble ( k ) / ( 1.0D+00 - e )
+
+    cvr = cvr + g(i) * dble ( l ) * dfdt / gascon()
+
+  end do
+
+  qp = 0.0D+00
+  q2a = 0.0D+00
+
+  do j = 37, 40
+
+    k = ii(j)
+    ddz = adz(j-36)
+    del = rho / ddz - 1.0D+00
+
+    if ( abs ( del ) < errtol ) then
+      del = errtol
+    end if
+
+    ex1 = - aad(j-36) * del**k
+!   ex1 = max ( ex1, - 225.0D+00 )
+!   ex1 = min ( ex1, 225.0D+00 )
+    dex = exp ( ex1 ) * del**jj(j)
+
+    att = aat(j-36)
+    tx = atz(j-36)
+    tau = ( t / tx ) - 1.0D+00
+
+    ex2 = - att * tau**2
+!   ex2 = max ( ex2, - 225.0D+00 )
+!   ex2 = min ( ex2, 225.0D+00 )
+    q10 = dex * exp ( ex2 )
+
+    qm = dble ( jj(j) ) / del - dble ( k ) * aad(j-36) * del**(k-1)
+    fct = qm * rho**2 * q10 / ddz
+
+    q5t = fct * ( 2.0D+00 / rho + qm / ddz ) - ( rho / ddz )**2 * q10 * &
+      ( dble ( jj(j) ) / del**2 + dble ( k * ( k - 1 ) ) * aad(j-36) * &
+      del**(k-2) )
+
+    dpdrr = dpdrr + q5t * g(j)
+    qp = qp + g(j) * fct
+    dadt = dadt - 2.0D+00 * g(j) * att * tau * q10 / tx
+    dpdtr = dpdtr - 2.0D+00 * g(j) * att * tau * fct / tx
+
+    q2a = q2a + t * g(j) * att * ( 4.0D+00 * ex2 + 2.0D+00 ) * q10 / tx**2
+
+    ar = ar + q10 * g(j) / ( gascon() * t )
+
+  end do
+
+  cvr = cvr + q2a / gascon()
+  pr = pr + qp
+  sr = - dadt / gascon()
+  ur = ar + sr
+!
+!  Assign dimensions.
+!
+  ar =  gascon() * t *  ar
+  cvr = gascon() *     cvr
+  sr =  gascon() *      sr
+  ur =  gascon() * t *  ur
+!
+!  Adjust energies.
+!
+  ar = ar + gascon ( ) * t * s_ref - gascon ( ) * u_ref
+  sr = sr - gascon ( ) * s_ref
+  ur = ur - gascon ( ) * u_ref
+
+  gr = ar + pr / rho
+  hr = ur + pr / rho
+
+  return
+end subroutine resid
+
+subroutine psat_H2O ( t, p )
+!
+!*******************************************************************************
+!
+!! PSAT_H2O makes a rough estimate of the vapor pressure.
+!
+!
+!  Discussion:
+!
+!    The calculation agrees with tabulated data to within
+!    0.02% for temperature to within a degree or so of the critical
+!    temperature.  The approximate vapor pressure can be refined
+!    by imposing the condition that the Gibbs functions of the vapor
+!    and liquid phases be equal.
+!
+!  Modified:
+!
+!    21 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision P, the vapor pressure, in MegaPascals.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 8 ) :: a = (/ &
+    -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
+    -105.38479D+00,   174.35319D+00,  -148.39348D+00, 48.631602D+00 /)
+  double precision b
+  integer i
+  double precision p
+  double precision q
+  double precision t
+  double precision, parameter :: t_ref = 647.25D+00
+  double precision v
+  double precision w
+  double precision z
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'PSAT_H2O - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  if ( t <= 314.0D+00 ) then
+
+    p = 0.1D+00 * exp ( 6.3573118D+00 - 8858.843D+00 / t &
+      + 607.56335D+00 * t**( -0.6D+00 ) )
+
+  else
+
+    v = t / t_ref
+    w = abs ( 1.0D+00 - v )
+    b = 0.0D+00
+    do i = 1, 8
+      z = i
+      b = b + a(i) * w**( ( z + 1.0D+00 ) / 2.0D+00 )
+    end do
+
+    q = b / v
+    p = 22.093D+00 * exp ( q )
+
+  end if
+
+  return
+end subroutine psat_H2O
+
+
+subroutine tdpsdt ( t, dp )
+!
+!*******************************************************************************
+!
+!! TDPSDT computes the quantity T * dP(Sat)/dT.
+!
+!
+!  Discussion:
+!
+!    Here T is the temperature and P(Sat) is the vapor pressure.  
+!    It is used by TSAT_EST and TSAT.
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Output, double precision DP, the value T*(dP(Sat)/dT), 
+!    in MegaPascals.
+!
+  implicit none
+!
+  double precision, parameter, dimension ( 8 ) :: a = (/ &
+      -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
+    -105.38479D+00,   174.35319D+00,   -148.39348D+00,  48.631602D+00 /)
+  double precision b
+  double precision c
+  double precision dp
+  integer i
+  double precision q
+  double precision t
+  double precision, parameter :: t_ref = 647.25D+00
+  double precision v
+  double precision w
+  double precision y
+  double precision z
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'TDPSDT - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+
+  v = t / t_ref
+  w = 1.0D+00 - v
+  b = 0.0D+00
+  c = 0.0D+00
+  do i = 1, 8
+    z = dble ( i + 1 ) / 2.0D+00
+    y = a(i) * w**z
+    c = c + ( y / w ) * ( 0.5D+00 - 0.5D+00 * dble ( i ) - 1.0D+00 / v )
+    b = b + y
+  end do
+
+  q = b / v
+  dp = 22.093D+00 * exp ( q ) * c
+
+  return
+end subroutine tdpsdt
+
+
+
+subroutine therm ( t, rho, a, cjth, cjtt, cp, cv, dpdr, dpdt, g, h, p, s, u )
+!
+!*******************************************************************************
+!
+!! THERM calculates thermodynamic functions given temperature and density.
+!
+!
+!  Discussion:
+!
+!    Thermodynamic values were calculated from an analytic equation
+!    that approximates the Helmholtz function (specific Helmholtz
+!    energy) for ordinary water and steam, of the form A=A(rho,T)
+!    where A is the Helmholtz function, rho the density, and T
+!    the absolute (thermodynamic) temperature.  Any thermodynamic
+!    value for any state, liquid, vapor or metastable, may be
+!    calculated by differentiation of this equation in accord with
+!    the first and second laws of thermodynamics.
+! 
+!    The International Association for the Properties of Steam
+!    has provisionally accepted this formulation for the range
+!    273.15 <= T <= 1273.15 degrees Kelvin, where, for 423.15 <= T,
+!    the maximum pressure is Pmax = 1500 MPa = 15000 bar, and for
+!    273.15 <= T < 423.15, the maximum pressure is
+!    Pmax = 100 * (5 + (T-273.15)/15) MPa.
+! 
+!    Close to the critical point, a small region is excluded:
+!    Abs(T-Tk) < 1, abs((rho-rhok)/rhok) < 0.3.
+! 
+!    The equation has a wider useful range, namely, fluid states
+!    of pure, undissociated water and steam defined by
+!    260 <= T <= 2500 K and 0 <= P <= 3000 MPa.
+! 
+!    Thermodynamic property values for specific volume, density,
+!    specific internal energy, specific enthalpy, and specific
+!    entropy of water and steam were tabulated over the range
+!    0 <= t <= 2000 C, 0 <= P <= 3000 MPa.  The reference
+!    state is the liquid at the triple point, for which the
+!    internal energy and entropy have been assigned the value zero.
+!     
+!    Thermodynamic quantities are determined from the Helmholtz function
+!    A(rho,T), which is computed as the sum of three terms:
+!
+!      A(rho,T) = A(base)(rho,T) + A(residual)(rho,T) + A(ideal)(T)
+!                                                       (Equation 1)
+!
+!    Because A(rho,T) is everywhere single valued and analytic,
+!    we can derive closed form relations for all other properties.
+!    In the following, unless otherwise indicated, the independent
+!    variables are temperature T and density RHO, and differentiation
+!    with respect to one variable is to imply that the other is fixed.
+! 
+!    Pressure:                  P       = RHO**2 * dA/dRHO
+!    Density derivative:        dP/dRHO = 2*P/RHO + RHO**2 * d2A/dRHO2
+!    Temperature derivative:    dP/dT   = RHO**2 * d2A/(dRHO dT)
+!    Specific entropy:          S       = - dA/dT
+!    Specific internal energy:  U       = A + T*S
+!    Specific enthalpy:         H       = U + P/RHO
+!    Specific heat capacity
+!      at constant volume:      Cv      = - T * d2A/dT2
+!    Specific Gibbs function:   G       = A + P/RHO
+!    Specific heat capacity
+!      at constant pressure:    Cp      = Cv + (T*(dP/dT)**2)/(RHO**2*dP/dRHO)
+!    Speed of sound:            Omega   = Sqrt ((Cp/Cv) * dP/dRHO)
+!    Second virial coefficient: B       = 1/(2*R*T) * (d2P/dRHO2) (at RHO=0)
+!    Isothermal Joule-Thomson
+!      coefficient:             DeltaT  = (dH/dP) (fixed T) =
+!                                         (1/RHO)-(T*dP/dT)/(RHO**2*dP/dRHO)
+!    Joule-Thomson coefficient: Mu      = (dT/dP) (fixed H) = DeltaT/Cp
+!    Isentropic temperature-
+!      pressure coefficient:    BetaS   = (dT/dP) (fixed S) =
+!                                         (DeltaT - 1/RHO)/Cp
+!   
+!  Modified:
+!
+!    19 November 1998
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Input, double precision T, the temperature, in degrees Kelvin.
+!
+!    Input, double precision RHO, the fluid density, in G/CM3.
+!
+!    Output, double precision A, the Helmholtz function, in KJ/kg.
+!
+!    Output, double precision CJTH, the Joule-Thomson coefficient,
+!    in K/MegaPascals.
+!
+!    Output, double precision CJTT, the isothermal Joule-Thomson coefficient,
+!    in CM3/G.
+!
+!    Output, double precision CP, the isobaric (constant pressure) heat
+!    capacity, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision CV, the isochoric (constant volume) heat capacity,
+!    in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision DPDR, the partial derivative 
+!    dP(T,RHO)/dRHO, with T held fixed, in MegaPascals*CM3/G.
+!
+!    Output, double precision DPDT, the partial derivative 
+!    dP(T,RHO)/dT, with RHO held fixed, in MegaPascals/degrees Kelvin.
+!
+!    Output, double precision G, the Gibbs free energy, in KJ/kg.
+!
+!    Output, double precision H, the enthalpy, in KJ/kg.
+!
+!    Output, double precision P, the pressure, in MegaPascals.
+!
+!    Output, double precision S, the entropy, in KJ/(kg degrees Kelvin).
+!
+!    Output, double precision U, the internal energy, in KJ/kg.
+!
+  implicit none
+!
+  double precision a
+  double precision ab
+  double precision ai
+  double precision ar
+  double precision cjth
+  double precision cjtt
+  double precision cp
+  double precision cpi
+  double precision cv
+  double precision cvb
+  double precision cvi
+  double precision cvr
+  logical, parameter :: debug = .false.
+!  logical, parameter :: debug = .true.
+  double precision dpdr
+  double precision dpdrb
+  double precision dpdrr
+  double precision dpdt
+  double precision dpdtb
+  double precision dpdtr
+  double precision g
+  double precision gb
+  double precision gi
+  double precision gr
+  double precision h
+  double precision hb
+  double precision hi
+  double precision hr
+  double precision p
+  double precision pb
+  double precision pr
+  double precision rho
+  double precision s
+  double precision sb
+  double precision si
+  double precision sr
+  double precision t
+  double precision u
+  double precision ub
+  double precision ui
+  double precision ur
+!
+!  Refuse to handle zero or negative temperatures.
+!
+  if ( t <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'THERM - Fatal error!'
+    write ( *, '(a)' ) '  The input temperature T must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
+    stop
+  end if
+!
+!  Refuse to handle zero or negative density.
+!
+  if ( rho <= 0.0D+00 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'THERM - Fatal error!'
+    write ( *, '(a)' ) '  The input density RHO must be positive.'
+    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
+    stop
+  end if
+
+  call ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
+
+  call resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
+
+  call base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
+
+  a =       ab +    ar +  ai
+  cv =     cvb +   cvr + cvi
+
+  if ( debug ) then
+    write ( *, * ) ' '
+    write ( *, * ) 'THERM:'
+    write ( *, * ) '  CVB = ', cvb
+    write ( *, * ) '  CVR = ', cvr
+    write ( *, * ) '  CVI = ', cvi
+    write ( *, * ) '  CV  = ', cv
+  end if
+
+
+  dpdr = dpdrb + dpdrr
+  dpdt = dpdtb + dpdtr
+  p =       pb +    pr
+  s =       sb +    sr +  si
+  u =       ub +    ur +  ui
+
+  if ( debug ) then
+    write ( *, * ) ' '
+    write ( *, * ) 'THERM:'
+    write ( *, * ) '  UB = ', ub
+    write ( *, * ) '  UR = ', ur
+    write ( *, * ) '  UI = ', ui
+  end if
+
+  g = a + p / rho
+  h = u + p / rho
+  cp = cv + t * dpdt**2 / ( dpdr * rho**2 )
+  cjtt = 1.0D+00 / rho - t * dpdt / ( dpdr * rho**2 )
+  cjth = - cjtt / cp
+
+  return
+end subroutine therm
+
+function gascon ( )
+!
+!*******************************************************************************
+!
+!! GASCON returns the value of the specific gas constant.
+!
+!
+!  Note:
+!
+!    The specific gas constant R is related to the universal gas
+!    constant R-bar = 8.31441 J/(mol degrees Kelvin) by the molar mass 
+!    M = 18.0152 g/mol:
+!
+!      R = R-bar / M.
+!
+!  Reference:
+!
+!    Lester Haar, John Gallagher and George Kell,
+!    NBS/NRC Steam Tables:
+!    Thermodynamic and Transport Properties and Computer Programs
+!      for Vapor and Liquid States of Water in SI Units,
+!    Hemisphere Publishing Corporation, Washington, 1984,
+!    TJ270.H3
+!
+!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
+!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
+!    American Society of Mechanical Engineers, 1967.
+!
+!  Parameters:
+!
+!    Output, double precision GASCON, the value of the specific gas 
+!    constant, in J/(g degrees Kelvin).
+!
+  implicit none
+!
+  double precision gascon
+!
+  gascon = 0.461522D+00
+ 
+  return
+end function gascon
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/rcm1d.F	(revision 1403)
@@ -0,0 +1,927 @@
+      program rcm1d
+
+! to use  'getin'
+      use ioipsl_getincom, only: getin
+      use infotrac, only: nqtot, tname
+      use surfdat_h, only: albedodat, phisfi, dryness, watercaptag,
+     &                     zmea, zstd, zsig, zgam, zthe,
+     &                     emissiv, emisice, albedice, iceradius,
+     &                     dtemisice
+      use comdiurn_h, only: sinlat, coslat, sinlon, coslon
+!      use comsaison_h
+      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat, volcapa
+      USE comgeomfi_h, only: lati, long, area
+      use control_mod, only: day_step, ecritphy
+      use phyredem, only: physdem0,physdem1
+      use comgeomphy, only: initcomgeomphy
+      use slab_ice_h, only: noceanmx
+      use planete_mod, only: apoastr,periastr,year_day,peri_day,
+     &         obliquit,nres,z0,lmixmin,emin_turb,coefvis,coefir,
+     &         timeperi,e_elips,p_elips
+      use comcstfi_mod, only: pi, cpp, daysec, dtphys, rad, g, r,
+     &                        mugaz, rcp, omeg
+      use callkeys_mod, only: tracer,check_cpp_match,rings_shadow,
+     &		specOLR,water,pceil,ok_slab_ocean
+      implicit none
+
+!==================================================================
+!     
+!     Purpose
+!     -------
+!     Run the physics package of the universal model in a 1D column.
+!     
+!     It can be compiled with a command like (e.g. for 25 layers):
+!                                  "makegcm -p std -d 25 rcm1d"
+!     It requires the files "callphys.def", "z2sig.def",
+!     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
+!
+!     Authors
+!     -------
+!     Frederic Hourdin
+!     R. Fournier
+!     F. Forget
+!     F. Montmessin (water ice added)
+!     R. Wordsworth
+!     B. Charnay
+!     A. Spiga
+!     J. Leconte (2012)
+!
+!==================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+!include "dimphys.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "logic.h"
+#include "comgeom.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(llm+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf(1)      
+      REAL u(llm),v(llm)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(llm)   ! temperature at the middle of the layers
+      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL,ALLOCATABLE :: qsurf(:)      ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+!      REAL co2ice           ! co2ice layer (kg.m-2) !not used anymore
+      integer :: i_co2_ice=0  ! tracer index of co2 ice
+      integer :: i_h2o_ice=0  ! tracer index of h2o ice
+      integer :: i_h2o_vap=0  ! tracer index of h2o vapor
+      REAL emis(1)             ! surface layer
+      REAL q2(llm+1)   ! Turbulent Kinetic Energy
+      REAL zlay(llm)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(llm),dv(llm),dtemp(llm)
+      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
+      REAL dpsurf    
+      REAL,ALLOCATABLE :: dq(:,:)
+      REAL,ALLOCATABLE :: dqdyn(:,:)
+
+c   Various intermediate variables
+!      INTEGER thermo
+      REAL zls
+      REAL phi(llm),h(llm),s(llm)
+      REAL pks, ptif, w(llm)
+      INTEGER ierr, aslun
+      REAL tmp1(0:llm),tmp2(0:llm)
+      Logical  tracerdyn
+      integer :: nq !=1 ! number of tracers
+ 
+      character*2 str2
+      character (len=7) :: str7
+
+      logical oldcompare, earthhack,saveprofile
+
+!     added by RW for zlay computation
+      real Hscale, Hmax, rho, dz
+
+!     added by RW for autozlevs computation
+      real nu, xx, pMIN, zlev, Htop
+      real logplevs(llm)
+
+!     added by BC
+      REAL cloudfrac(1,llm)
+      REAL hice(1),totcloudfrac(1)
+      REAL qzero1D   !initial water amount on the ground
+
+!     added by BC for ocean
+      real rnat(1)
+      REAL tslab(1,noceanmx),tsea_ice(1),sea_ice(1)
+      real pctsrf_sic(1)
+
+
+
+!     added by AS to avoid the use of adv trac common
+      character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
+
+      real :: latitude, longitude
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+      !! those are defined in surfdat_h.F90
+      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(1))
+      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(1))
+      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(1))
+      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(1))
+      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(1))
+      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(1))
+      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(1))
+      IF (.not. ALLOCATED(dryness)) ALLOCATE(dryness(1))
+      IF (.not. ALLOCATED(watercaptag)) ALLOCATE(watercaptag(1))
+      !! those are defined in comdiurn_h.F90
+      IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(1))
+      IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(1))
+      IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(1))
+      IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(1))
+      !! those are defined in comsoil_h.F90
+      IF (.not.ALLOCATED(layer)) ALLOCATE(layer(nsoilmx))
+      IF (.not.ALLOCATED(mlayer)) ALLOCATE(mlayer(0:nsoilmx-1))
+      IF (.not.ALLOCATED(inertiedat)) ALLOCATE(inertiedat(1,nsoilmx))
+      !! those are defined in comgeomfi_h
+      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(1))
+      IF (.not. ALLOCATED(long)) ALLOCATE(long(1))
+      IF (.not. ALLOCATED(area)) ALLOCATE(area(1))
+
+
+      saveprofile=.false.
+      saveprofile=.true.
+
+c ----------------------------------------
+c  Default values  (corresponding to Mars)
+c ----------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Parametres Couche limite et Turbulence 
+c     --------------------------------------
+      z0 =  1.e-2                ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! energie minimale ~1.e-8
+      lmixmin = 30               ! longueur de melange ~100
+ 
+c     propriete optiques des calottes et emissivite du sol
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Emissivite du sol martien ~.95
+      emisice(1)=0.95            ! Emissivite calotte nord
+      emisice(2)=0.95            ! Emissivite calotte sud  
+
+      albedice(1)=0.5            ! Albedo calotte nord
+      albedice(2)=0.5            ! Albedo calotte sud
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+      hybrid=.false.
+
+c ------------------------------------------------------
+c  Load parameters from "run.def" and "gases.def" 
+c ------------------------------------------------------
+
+! check if 'rcm1d.def' file is around 
+      open(90,file='rcm1d.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.ne.0) then
+        write(*,*) 'Cannot find required file "rcm1d.def"'
+        write(*,*) 'which should contain some input parameters'
+        write(*,*) ' ... might as well stop here ...'
+        stop
+      else
+        close(90)
+      endif
+
+! now, run.def is needed anyway. so we create a dummy temporary one
+! for ioipsl to work. if a run.def is already here, stop the
+! program and ask the user to do a bit of cleaning
+      open(90,file='run.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.eq.0) then
+        close(90)
+        write(*,*) 'There is already a run.def file.'
+        write(*,*) 'This is not compatible with 1D runs.'
+        write(*,*) 'Please remove the file and restart the run.'
+        write(*,*) 'Runtime parameters are supposed to be in rcm1d.def'
+        stop
+      else
+        call system('touch run.def')
+        call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
+        call system("echo 'INCLUDEDEF=rcm1d.def' >> run.def")
+      endif
+
+! check if we are going to run with or without tracers
+      write(*,*) "Run with or without tracer transport ?"
+      tracer=.false. ! default value
+      call getin("tracer",tracer)
+      write(*,*) " tracer = ",tracer
+
+! OK. now that run.def has been read once -- any variable is in memory.
+! so we can dump the dummy run.def
+      call system("rm -rf run.def")
+
+! while we're at it, check if there is a 'traceur.def' file
+! and preocess it, if necessary. Otherwise initialize tracer names
+      if (tracer) then
+      ! load tracer names from file 'traceur.def'
+        open(90,file='traceur.def',status='old',form='formatted',
+     &       iostat=ierr)
+        if (ierr.eq.0) then
+          write(*,*) "rcm1d: Reading file traceur.def"
+          ! read number of tracers:
+          read(90,*,iostat=ierr) nq
+          nqtot=nq ! set value of nqtot (in infotrac module) as nq
+          if (ierr.ne.0) then
+            write(*,*) "rcm1d: error reading number of tracers"
+            write(*,*) "   (first line of traceur.def) "
+            stop
+          endif
+          if (nq>0) then
+            allocate(tname(nq))
+            allocate(q(llm,nq))
+            allocate(qsurf(nq))
+            allocate(dq(llm,nq))
+            allocate(dqdyn(llm,nq))
+          else
+            write(*,*) "rcm1d: Error. You set tracer=.true."
+            write(*,*) "       but # of tracers in traceur.def is ",nq
+            stop
+          endif
+        
+          do iq=1,nq
+          ! minimal version, just read in the tracer names, 1 per line
+            read(90,*,iostat=ierr) tname(iq)
+            if (ierr.ne.0) then
+              write(*,*) 'rcm1d: error reading tracer names...'
+              stop
+            endif
+          enddo !of do iq=1,nq
+! check for co2_ice / h2o_ice tracers:
+         i_co2_ice=0
+         i_h2o_ice=0
+         i_h2o_vap=0
+         do iq=1,nq
+           if (tname(iq)=="co2_ice") then
+             i_co2_ice=iq
+           elseif (tname(iq)=="h2o_ice") then
+             i_h2o_ice=iq
+           elseif (tname(iq)=="h2o_vap") then
+             i_h2o_vap=iq
+           endif
+         enddo
+        else
+          write(*,*) 'Cannot find required file "traceur.def"'
+          write(*,*) ' If you want to run with tracers, I need it'
+          write(*,*) ' ... might as well stop here ...'
+          stop
+        endif
+        close(90)
+
+      else ! of if (tracer)
+        nqtot=0
+        nq=0
+        ! still, make allocations for 1 dummy tracer
+        allocate(tname(1)) 
+        allocate(qsurf(1))
+        allocate(q(llm,1))
+        allocate(dq(llm,1))
+      
+       ! Check that tracer boolean is compliant with number of tracers
+       ! -- otherwise there is an error (and more generally we have to be consistent)
+       if (nq .ge. 1) then
+          write(*,*) "------------------------------"
+          write(*,*) "rcm1d: You set tracer=.false."
+          write(*,*) " But set number of tracers to ",nq
+          write(*,*) " > If you want tracers, set tracer=.true."
+          write(*,*) "------------------------------"
+          stop
+       endif
+      endif ! of if (tracer)
+
+!!! We have to check that check_cpp_match is F for 1D computations
+!!! We think this check is better than make a particular case for 1D in inifis or calc_cpp_mugaz
+      check_cpp_match = .false.
+      call getin("check_cpp_match",check_cpp_match)
+      if (check_cpp_match) then
+          print*,"In 1D modeling, check_cpp_match is supposed to be F"
+          print*,"Please correct callphys.def"
+          stop
+      endif
+
+!!! GEOGRAPHICAL INITIALIZATIONS
+     !!! AREA. useless in 1D
+      area(1)=1.E+0
+      aire(1)=area(1) !JL+EM to have access to the area in the diagfi.nc files. area in comgeomfi.h and aire in comgeom.h
+     !!! GEOPOTENTIAL. useless in 1D because control by surface pressure
+      phisfi(1)=0.E+0
+     !!! LATITUDE. can be set. 
+      latitude=0 ! default value for latitude
+      PRINT *,'latitude (in degrees) ?'
+      call getin("latitude",latitude)
+      write(*,*) " latitude = ",latitude
+      latitude=latitude*pi/180.E+0
+     !!! LONGITUDE. useless in 1D.
+      longitude=0.E+0
+      longitude=longitude*pi/180.E+0
+
+!!! CALL INIFIS
+!!! - read callphys.def
+!!! - calculate sine and cosine of longitude and latitude
+!!! - calculate mugaz and cp 
+!!! NB: some operations are being done dummily in inifis in 1D
+!!! - physical constants: nevermind, things are done allright below
+!!! - physical frequency: nevermind, in inifis this is a simple print
+      cpp=1.d-7 !JL because we divide by cpp in inifis, there may be a more elegant solution
+      CALL inifis(1,llm,nq,day0,daysec,dtphys,
+     .            latitude,longitude,area,rad,g,r,cpp)
+!!! We check everything is OK.
+      PRINT *,"CHECK"
+      PRINT *,"--> mugaz = ",mugaz
+      PRINT *,"--> cpp = ",cpp
+      r = 8.314511E+0 * 1000.E+0 / mugaz
+      rcp = r / cpp
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! PLANETARY CONSTANTS !!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      g = -99999.
+      PRINT *,'GRAVITY in m s-2 ?'
+      call getin("g",g)
+      IF (g.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED g IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> g = ",g
+      ENDIF
+
+      rad = -99999.
+      PRINT *,'PLANETARY RADIUS in m ?'
+      call getin("rad",rad)
+      ! Planetary  radius is needed to compute shadow of the rings
+      IF (rad.eq.-99999. .and. rings_shadow .eqv. .true.) THEN
+          PRINT *,"STOP. I NEED rad IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> rad = ",rad
+      ENDIF
+
+      daysec = -99999.
+      PRINT *,'LENGTH OF A DAY in s ?'
+      call getin("daysec",daysec)
+      IF (daysec.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED daysec IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> daysec = ",daysec
+      ENDIF
+      omeg=4.*asin(1.)/(daysec)
+      PRINT *,"OK. FROM THIS I WORKED OUT:"
+      PRINT *,"--> omeg = ",omeg
+
+      year_day = -99999.
+      PRINT *,'LENGTH OF A YEAR in days ?'
+      call getin("year_day",year_day)
+      IF (year_day.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED year_day IN RCM1D.DEF."
+          STOP
+      ELSE 
+          PRINT *,"--> year_day = ",year_day
+      ENDIF
+
+      periastr = -99999.
+      PRINT *,'MIN DIST STAR-PLANET in AU ?'
+      call getin("periastr",periastr)
+      IF (periastr.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED periastr IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> periastr = ",periastr
+      ENDIF
+
+      apoastr = -99999.
+      PRINT *,'MAX DIST STAR-PLANET in AU ?'
+      call getin("apoastr",apoastr)
+      IF (apoastr.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED apoastr IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> apoastr = ",apoastr
+      ENDIF
+
+      peri_day = -99999.
+      PRINT *,'DATE OF PERIASTRON in days ?'
+      call getin("peri_day",peri_day)
+      IF (peri_day.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED peri_day IN RCM1D.DEF."
+          STOP
+      ELSE IF (peri_day.gt.year_day) THEN
+          PRINT *,"STOP. peri_day.gt.year_day"
+          STOP
+      ELSE  
+          PRINT *,"--> peri_day = ", peri_day
+      ENDIF 
+
+      obliquit = -99999. 
+      PRINT *,'OBLIQUITY in deg ?'
+      call getin("obliquit",obliquit)
+      IF (obliquit.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED obliquit IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> obliquit = ",obliquit
+      ENDIF 
+
+      psurf = -99999.
+      PRINT *,'SURFACE PRESSURE in Pa ?'
+      call getin("psurf",psurf)
+      IF (psurf.eq.-99999.) THEN
+          PRINT *,"STOP. I NEED psurf IN RCM1D.DEF."
+          STOP
+      ELSE
+          PRINT *,"--> psurf = ",psurf
+      ENDIF
+      !! we need reference pressures
+      pa=psurf/30.
+      preff=psurf ! these values are not needed in 1D  (are you sure JL12)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! END PLANETARY CONSTANTS !!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0 ! default value for day0
+      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+      call getin("day0",day0)
+      day=float(day0)
+      write(*,*) " day0 = ",day0
+c  Heure de demarrage
+      time=0 ! default value for time
+      write(*,*)'Initial local time (in hours, between 0 and 24)?'
+      call getin("time",time)
+      write(*,*)" time = ",time
+      time=time/24.E+0 ! convert time (hours) to fraction of sol
+
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=llm
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+
+      day_step=48 ! default value for day_step
+      PRINT *,'Number of time steps per sol ?'
+      call getin("day_step",day_step)
+      write(*,*) " day_step = ",day_step
+
+       
+      ecritphy=day_step ! default value for ecritphy
+      PRINT *,'Nunber of steps between writediagfi ?'
+      call getin("ecritphy",ecritphy)
+      write(*,*) " ecritphy = ",ecritphy
+
+      ndt=10 ! default value for ndt
+      PRINT *,'Number of sols to run ?'
+      call getin("ndt",ndt)
+      write(*,*) " ndt = ",ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+      write(*,*)"-------------------------------------"
+      write(*,*)"-------------------------------------"
+      write(*,*)"--> Physical timestep is ",dtphys
+      write(*,*)"-------------------------------------"
+      write(*,*)"-------------------------------------"
+
+c output spectrum?
+      write(*,*)"Output spectral OLR?"
+      specOLR=.false.
+      call getin("specOLR",specOLR)
+      write(*,*)" specOLR = ",specOLR
+
+c
+c  pour le schema d'ondes de gravite
+c  ---------------------------------
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nq
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+     
+      DO iq=1,nq
+        qsurf(iq) = 0.
+      ENDDO
+
+      if (water) then
+         qzero1D               = 0.0
+         qsurf(i_h2o_vap) = qzero1D
+      endif
+
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+
+c    vent geostrophique
+      gru=10. ! default value for gru
+      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
+      call getin("u",gru)
+      write(*,*) " u = ",gru
+      grv=0. !default value for grv
+      PRINT *,'meridional northward component of the geostrophic',
+     &' wind (m/s) ?'
+      call getin("v",grv)
+      write(*,*) " v = ",grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     energie cinetique turbulente
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  emissivity / surface co2 ice ( + h2o ice??)
+c  -------------------------------------------
+      emis(1)=emissiv ! default value for emissivity
+      PRINT *,'Emissivity of bare ground ?'
+      call getin("emis",emis(1))
+      write(*,*) " emis = ",emis(1)
+      emissiv=emis(1) ! we do this so that condense_co2 sets things to the right
+                   ! value if there is no snow
+
+      if(i_co2_ice.gt.0)then
+         qsurf(i_co2_ice)=0 ! default value for co2ice
+         print*,'Initial CO2 ice on the surface (kg.m-2)'
+         call getin("co2ice",qsurf(i_co2_ice))
+         write(*,*) " co2ice = ",qsurf(i_co2_ice)
+         IF (qsurf(i_co2_ice).ge.1.E+0) THEN
+            ! if we have some CO2 ice on the surface, change emissivity
+            if (lati(1).ge.0) then ! northern hemisphere
+              emis(1)=emisice(1)
+            else ! southern hemisphere
+              emis(1)=emisice(2)
+            endif
+         ENDIF
+      endif
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      hybrid=.true.
+      PRINT *,'Hybrid coordinates ?'
+      call getin("hybrid",hybrid)
+      write(*,*) " hybrid = ", hybrid
+
+
+      autozlevs=.false.
+      PRINT *,'Auto-discretise vertical levels ?'
+      call getin("autozlevs",autozlevs)
+      write(*,*) " autozlevs = ", autozlevs
+
+      pceil = psurf / 1000.0 ! Pascals
+      PRINT *,'Ceiling pressure (Pa) ?'
+      call getin("pceil",pceil)
+      write(*,*) " pceil = ", pceil
+
+! Test of incompatibility:
+! if autozlevs used, cannot have hybrid too
+
+      if (autozlevs.and.hybrid) then
+         print*,'Cannot use autozlevs and hybrid together!'
+         call abort
+      endif
+
+      if(autozlevs)then
+            
+         open(91,file="z2sig.def",form='formatted')
+         read(91,*) Hscale
+         DO ilayer=1,nlayer-2
+            read(91,*) Hmax
+         enddo
+         close(91)
+ 
+            
+         print*,'Hmax = ',Hmax,' km'
+         print*,'Auto-shifting Hscale to:'
+!     Hscale = Hmax / log(psurf/100.0)
+         Hscale = Hmax / log(psurf/pceil)
+         print*,'Hscale = ',Hscale,' km'
+         
+! none of this matters if we dont care about zlay
+         
+      endif
+
+      call disvert
+
+         if(.not.autozlevs)then
+            ! we want only the scale height from z2sig, in order to compute zlay
+            open(91,file="z2sig.def",form='formatted')
+            read(91,*) Hscale
+            close(91)
+         endif
+
+!         if(autozlevs)then
+!            open(94,file="Hscale.temp",form='formatted')
+!            read(94,*) Hscale
+!            close(94)
+!         endif
+
+         DO ilevel=1,nlevel
+            plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+         ENDDO
+         
+         DO ilayer=1,nlayer
+            play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+         ENDDO
+         
+
+
+         DO ilayer=1,nlayer
+!     zlay(ilayer)=-300.E+0 *r*log(play(ilayer)/plev(1))
+!     &   /g
+            zlay(ilayer)=-1000.0*Hscale*log(play(ilayer)/plev(1))
+         ENDDO
+
+!      endif
+
+c  profil de temperature au premier appel
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude en km dans profile: on divise zlay par 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+      call profile(nlayer+1,tmp1,tmp2)
+
+      tsurf(1)=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      print*,"check"
+      PRINT*,"INPUT SURFACE TEMPERATURE",tsurf(1)
+      PRINT*,"INPUT TEMPERATURE PROFILE",temp
+
+c  Initialisation albedo / inertie du sol
+c  --------------------------------------
+      albedodat(1)=0.2 ! default value for albedodat
+      PRINT *,'Albedo of bare ground ?'
+      call getin("albedo",albedodat(1))
+      write(*,*) " albedo = ",albedodat(1)
+
+      inertiedat(1,1)=400 ! default value for inertiedat
+      PRINT *,'Soil thermal inertia (SI) ?'
+      call getin("inertia",inertiedat(1,1))
+      write(*,*) " inertia = ",inertiedat(1,1)
+
+! Initialize soil properties and temperature
+! ------------------------------------------
+      volcapa=1.e6 ! volumetric heat capacity
+      DO isoil=1,nsoil
+         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+         tsoil(isoil)=tsurf(1)  ! soil temperature
+      ENDDO
+
+! Initialize depths
+! -----------------
+      do isoil=0,nsoil-1
+        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
+      enddo
+      do isoil=1,nsoil
+        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
+      enddo
+
+
+! Initialize slab ocean
+! -----------------
+      rnat=1. ! default value for rnat
+      if(inertiedat(1,1).GE.10000.)then
+         rnat=0.
+      endif
+      if(ok_slab_ocean)then
+      rnat=0.
+      tslab(1,1)=tsurf(1)
+      tslab(1,2)=tsurf(1)
+      tsea_ice=tsurf
+      pctsrf_sic=0.
+      sea_ice=0.
+      endif
+
+
+
+c  Write a "startfi" file
+c  --------------------
+c  This file will be read during the first call to "physiq".
+c  It is needed to transfert physics variables to "physiq"...
+
+      call physdem0("startfi.nc",long,lati,nsoilmx,1,llm,nq,
+     &              dtphys,real(day0),time,area,
+     &              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("startfi.nc",nsoilmx,1,llm,nq,
+     &                dtphys,time,
+     &                tsurf,tsoil,emis,q2,qsurf,
+     &                cloudfrac,totcloudfrac,hice, 
+     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
+
+!      call physdem1(1,"startfi.nc",long,lati,nsoilmx,nq,
+!     &              dtphys,float(day0),
+!     &              time,tsurf,tsoil,emis,q2,qsurf,
+!     &              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe,
+!     &              cloudfrac,totcloudfrac,hice,nametrac)
+
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+        IF (idt.eq.ndt) then       !test
+         lastcall=.true.
+         call stellarlong(day*1.0,zls)
+!         write(103,*) 'Ls=',zls*180./pi
+!         write(103,*) 'Lat=', lati(1)*180./pi
+!         write(103,*) 'RunEnd - Atmos. Temp. File'
+!         write(103,*) 'RunEnd - Atmos. Temp. File'
+!         write(104,*) 'Ls=',zls*180./pi
+!         write(104,*) 'Lat=', lati(1)
+!         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+
+
+      DO ilayer=1,nlayer
+
+!              if(autozlevs)then
+!                 s(ilayer)=(play(ilayer)/psurf)**rcp
+!              else
+          s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+!              endif
+              !s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+          h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+       ENDDO
+
+!      DO ilayer=1,nlayer
+!        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+!        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+!      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+
+      CALL physiq (1,llm,nq,
+     .     tname,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - sorties
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       on y rajoute betement un effet Coriolis.
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       Pour certain test : pas de coriolis a l'equateur
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+                 play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+c       calcul traceur au pas de temps suivant
+c       --------------------------------------
+
+        DO iq = 1, nq
+          DO ilayer=1,nlayer
+             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+          ENDDO
+        END DO
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+      if(saveprofile)then
+         OPEN(12,file='profile.out',form='formatted')
+         write(12,*) tsurf
+         DO ilayer=1,llm
+            write(12,*) temp(ilayer) !, play(ilayer) !AS12 only temp so that iprofile=8 can be used
+         ENDDO
+         CLOSE(12)
+      endif
+
+
+      ENDDO   ! fin de la boucle temporelle
+
+      write(*,*) "rcm1d: Everything is cool."
+
+c    ========================================================
+      end                       !rcm1d
+ 
+c***********************************************************************
+c***********************************************************************
+c     Subroutines Bidons utilise seulement en 3D, mais
+c     necessaire a la compilation de rcm1d en 1D
+
+!      subroutine gr_fi_dyn
+!      RETURN
+!      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+!#include "../dyn3d/disvert.F"
+!#include "../dyn3d/abort_gcm.F"
+!#include "../dyn3d/diverg.F"
+!#include "../dyn3d/grad.F"
+!#include "../dyn3d/gr_u_scal.F"
+!#include "../dyn3d/gr_v_scal.F"
+!#include "../dyn3d/gr_dyn_fi.F"
+
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/serre.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/serre.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/serre.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/serre.h
Index: /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/temps.h
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/temps.h	(revision 1403)
+++ /trunk/LMDZ.GENERIC/libf/phystd/dyn1d/temps.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/temps.h
Index: unk/LMDZ.GENERIC/libf/phystd/gradients_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/gradients_kcm.F90	(revision 1402)
+++ 	(revision )
@@ -1,126 +1,0 @@
-subroutine gradients_kcm(profil_flag,rho_v,rho_n,T,dTdp,dPvdp,dPndp)
-
-  use params_h
-  use gases_h
-  implicit none
-
-  ! inputs
-  integer profil_flag ! 0 = dry, 1 = moist, 2 = isothermal
-  double precision rho_v,rho_n,T
-
-  ! outputs
-  double precision dTdp,dPndp,dPvdp
-  double precision a_v
-
-  ! internal
-  !double precision cp_n,cp_v
-  double precision cp_v
-
-  double precision press, rho_plus, rho_minus, dVdT, rho_c
-  double precision dlnr,dlna,dpsat,dsv
-  double precision s_minus,s_plus
-  double precision s_v,s_c,L
-  double precision psat_plus,psat_minus,Pn
-  double precision nul
-
-  ! functions
-  double precision cp_neutral
-
-  !cp_n = cp_neutral(T)
-
-  select case(profil_flag)
-  case(2) ! isothermal
-
-     dTdp  = 0.
-     a_v   = rho_v/rho_n ! constant here
-     dPndp = 1/(1d0+m_n/m_v*a_v)
-     dPvdp = 1 - dPndp
-
-  case(1) ! moist
-
-     Pn = rho_n*T*rmn
-
-     if(ngasmx.eq.1)then
-        print*,'Cannot have moist adiabat with one gas...'
-        stop
-     endif
-
-     if(trim(gnom(ngasmx)).eq.'H2O')then
-
-        call psat_H2O(T-2d-1,psat_minus)
-        call psat_H2O(T+2d-1,psat_plus)
-        call psat_H2O(T,press)
-
-        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
-        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
-
-        call therm(T-2d-1,rho_minus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
-                   nul,nul,press,s_minus,nul)
-        call therm(T+2d-1,rho_plus*1d-3,nul,nul,nul,nul,nul,nul,nul,&
-                   nul,nul,press,s_plus,nul)
-        s_c = 2.06 * log(T/273.15)
-
-        s_plus  = s_plus  * 1d3
-        s_minus = s_minus * 1d3
-        s_c     = s_c     * 1d3 ! convert to SI
-
-        if(T.lt.280.0)then 
-           dpsat = press*1d6 * ( 1730.63*log(10.) / (T-39.714)**2 )
-        else
-           call tdpsdt(T,dpsat)
-           dpsat = dpsat * 1d6 / T
-        endif
-
-     elseif(trim(gnom(ngasmx)).eq.'NH3')then
-
-        call psat_NH3(T-2d-1,psat_minus)
-        call psat_NH3(T+2d-1,psat_plus)
-        call psat_NH3(T,press)
-
-        rho_minus = m_v*psat_minus*1d6/(Rc*(T-2d-1))
-        rho_plus  = m_v*psat_plus*1d6/(Rc*(T+2d-1))
-
-        call latheat_NH3(T-2d-1,nul,s_minus)
-        call latheat_NH3(T+2d-1,nul,s_plus)
-        call latheat_NH3(T,s_c,nul)
-
-        dpsat = press*1d6 * (-2*1.5609d-4*T + 0.1236)
-
-     endif
-
-     dsv  = (s_plus-s_minus)/4d-1  ! dsv*T = ds / d ln[T]
-     s_v  = (s_plus+s_minus)/2d0
-     dlnr = T/rho_v * (rho_plus-rho_minus)/4d-1  ! d ln[rho_v] / d ln[T]
-
-     if(rho_n/rho_v.lt.1e-5)then
-        dlna = -T*dsv/(s_v-s_c)
-     else
-        a_v  = rho_v/rho_n
-        dlna = (rmn*dlnr - cp_n + rmn - a_v*T*dsv)/(a_v*(s_v-s_c)+rmn)  
-        ! d ln[alpha_v] / d ln[T]
-        ! note cp_n + rmn = cv_n, which is what's required
-     endif
-
-     dTdp  = 1d0 / (dpsat + rho_n*rmn*(1d0 + dlnr - dlna)) ! c.f. Marcq S2.2.2
-     dPvdp = dTdp * dpsat
-     dPndp = 1d0 - dPvdp ! from p = p_v + p_n
-
-  case(0) ! dry
-
-     cp_v=0.0
-     if(trim(gnom(ngasmx)).eq.'H2O')then
-        cp_v = (32.24+1.923d-3*T+1.055d-5*T**2-3.511d-9*T**3)/m_v
-     elseif(trim(gnom(ngasmx)).eq.'NH3')then
-        cp_v = 2.058d3
-     elseif(trim(gnom(ngasmx)).eq.'CH4')then
-        cp_v = 2.226d3
-     endif
-
-     dTdp  = 1/(rho_n*cp_n+rho_v*cp_v)
-     dPndp = 1/(1d0+m_n/m_v*rho_v/rho_n)
-     dPvdp = 1/(1d0+m_v/m_n*rho_n/rho_v)
-      
-  end select
-
-
-end subroutine gradients_kcm
Index: unk/LMDZ.GENERIC/libf/phystd/ini_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/ini_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,530 +1,0 @@
-c=======================================================================
-      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi,
-     &                       tab_cntrl_dyn)
-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	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
-c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
-c	 du RUN + ptotal et cotoicetotal)
-c
-c			tab_cntrl(50+l)=tab_cntrl_fi(l)
-c
-c   Arguments:
-c   ---------
-c
-c	Inputs:
-c   ------
-c
-c       nid            unite logique du fichier "start_archive"
-c       idayref        Valeur du jour initial a mettre dans
-c                      l'entete du fichier "start_archive"
-c       phis           geopotentiel au sol
-c       ith            soil thermal inertia
-c       tab_cntrl_fi   tableau des param physiques
-c
-
-c=======================================================================
-
-      USE comsoil_h
-!      use control_mod
-      implicit none
-
-#include "dimensions.h"
-!#include "dimphys.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "serre.h"
-!#include "control.h"
-
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c   Declarations
-c-----------------------------------------------------------------------
-
-c   Local:
-c   ------
-      INTEGER	length,l
-      parameter (length = 100)
-      REAL		tab_cntrl(length) ! tableau des parametres du run
-      INTEGER	loop
-      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
-      INTEGER	setdim
-      INTEGER	ind1,indlast
-
-c   Arguments:
-c   ----------
-      INTEGER*4	idayref
-      REAL		phis(ip1jmp1)
-      real ith(ip1jmp1,nsoilmx)
-      REAL		tab_cntrl_fi(length)
-      REAL tab_cntrl_dyn(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 idim_nsoilmx ! "subsurface_layers" dimension ID #
-      INTEGER nid,nvarid
-      real sig_s(llm),s(llm)
-
-      pi  = 2. * ASIN(1.)
-
-
-c-----------------------------------------------------------------------
-c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
-c-----------------------------------------------------------------------
-
-      DO l=1,length
-         tab_cntrl(l)=0.
-      ENDDO
-      
-      tab_cntrl(1:50)=tab_cntrl_dyn(1:50)
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-!      tab_cntrl(1)  = FLOAT(iim) ! nombre de points en longitude
-!      tab_cntrl(2)  = FLOAT(jjm) ! nombre de points en latitude
-!      tab_cntrl(3)  = FLOAT(llm) ! nombre de couches
-!      tab_cntrl(4)  = FLOAT(idayref) ! jour 0
-!      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
-!      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
-!      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
-!      tab_cntrl(8)  = cpp 
-!      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
-!      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
-!      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
-!      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
-!      tab_cntrl(12) = etot0 ! energie totale    !
-!      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
-!      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
-!      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
-!      tab_cntrl(16) = ang0 ! moment cinetique  !
-!      tab_cntrl(17) = pa
-!      tab_cntrl(18) = preff
-
-c    .....    parametres  pour le zoom      ......   
-
-!      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
-!      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
-!      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
-!      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
-
-!      IF ( fxyhypb )   THEN
-!       tab_cntrl(23) = 1.
-!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-!      ELSE
-!       tab_cntrl(23) = 0.
-!       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-!       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-!       tab_cntrl(26) = 0.
-!       IF ( ysinus)  tab_cntrl(26) = 1.
-!      ENDIF
-
-c-----------------------------------------------------------------------
-c   Copie du tableau des parametres de controle du RUN  (physique)
-c		dans le tableau tab_cntrl
-c-----------------------------------------------------------------------
-
-      DO l=1,50
-         tab_cntrl(50+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", 21,
-     &                       "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, "latitude", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
-      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
-
-      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
-      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid,"interlayer", 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-----------------------------------------------------------------------
-
-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,"aps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
-     .      "Coef AS: hybrid pressure in midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
-#endif
-c
-c ----------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
-     .      "Coef BS: hybrid sigma midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
-#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  Variable uniquement pour visualisation avec Grads ou Ferret
-c ------------------------------------------------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "North latitude")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
-#endif
-c----------------------
-       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "East longitude")
-      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
-#endif
-c--------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
-     .       idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
-     .       idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
-
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
-#endif
-
-!-------------------------------
-! (soil) depth variable mlayer() (known from comsoil.h)
-!-------------------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     .                        "Soil mid-layer depth")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
-#endif
-
-!---------------------
-! soil thermal inertia
-!---------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      dims3(1)=idim_rlonv
-      dims3(2)=idim_rlatu
-      dims3(3)=idim_nsoilmx
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     &                        "Soil thermal inertia")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
-     &                        "J.s-1/2.m-2.K-1")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
-#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
-
-      PRINT*,'ini_archive: iim,jjm,llm,idayref',iim,jjm,llm,idayref
-      PRINT*,'ini_archive: rad,omeg,g,mugaz,kappa',
-     s rad,omeg,g,tab_cntrl_fi(8),kappa
-      PRINT*,'ini_archive: daysec,dtvr',daysec,dtvr
-
-      RETURN
-      END
Index: unk/LMDZ.GENERIC/libf/phystd/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/iniphysiq.F90	(revision 1402)
+++ 	(revision )
@@ -1,145 +1,0 @@
-subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
-                     rlatu,rlonv,aire,cu,cv,                             &
-                     prad,pg,pr,pcpp,iflag_phys)
-
-use dimphy, only : klev ! number of atmospheric levels
-use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
-                                       ! (on full grid)
-use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
-                               klon_omp_begin, & ! start index of local omp subgrid
-                               klon_omp_end, & ! end index of local omp subgrid
-                               klon_mpi_begin ! start indes of columns (on local mpi grid)
-
-use comgeomphy, only : initcomgeomphy, &
-                       airephy, & ! physics grid area (m2)
-                       cuphy, & ! cu coeff. (u_covariant = cu * u)
-                       cvphy, & ! cv coeff. (v_covariant = cv * v)
-                       rlond, & ! longitudes
-                       rlatd ! latitudes
-use infotrac, only : nqtot ! number of advected tracers
-use planete_mod, only: ini_planete_mod
-
-implicit none
-include "dimensions.h"
-include "comvert.h"
-include "iniprint.h"
-
-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 (full grid)
-integer,intent(in) :: nlayer ! number of atmospheric layers
-integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
-integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
-real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
-real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
-real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
-real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
-real,intent(in) :: cv((ii+1)*jj) ! 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 :: ibegin,iend,offset
-integer :: i,j
-character(len=20) :: modname='iniphysiq'
-character(len=80) :: abort_message
-real :: total_area_phy, total_area_dyn
-
-
-! global array, on full physics grid:
-real,allocatable :: latfi(:)
-real,allocatable :: lonfi(:)
-real,allocatable :: cufi(:)
-real,allocatable :: cvfi(:)
-real,allocatable :: airefi(:)
-
-IF (nlayer.NE.klev) THEN
-  write(*,*) 'STOP in ',trim(modname)
-  write(*,*) 'Problem with dimensions :'
-  write(*,*) 'nlayer     = ',nlayer
-  write(*,*) 'klev   = ',klev
-  abort_message = ''
-  CALL abort_gcm (modname,abort_message,1)
-ENDIF
-
-!IF (ngrid.NE.klon_glo) THEN
-!  write(*,*) 'STOP in ',trim(modname)
-!  write(*,*) 'Problem with dimensions :'
-!  write(*,*) 'ngrid     = ',ngrid
-!  write(*,*) 'klon   = ',klon_glo
-!  abort_message = ''
-!  CALL abort_gcm (modname,abort_message,1)
-!ENDIF
-
-!call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-
-! Generate global arrays on full physics grid
-allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
-latfi(1)=rlatu(1)
-lonfi(1)=0.
-cufi(1) = cu(1)
-cvfi(1) = cv(1)
-DO j=2,jj
-  DO i=1,ii
-    latfi((j-2)*ii+1+i)= rlatu(j)
-    lonfi((j-2)*ii+1+i)= rlonv(i)
-    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
-    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
-  ENDDO
-ENDDO
-latfi(klon_glo)= rlatu(jj+1)
-lonfi(klon_glo)= 0.
-cufi(klon_glo) = cu((ii+1)*jj+1)
-cvfi(klon_glo) = cv((ii+1)*jj-ii)
-
-! build airefi(), mesh area on physics grid
-allocate(airefi(klon_glo))
-CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
-! Poles are single points on physics grid
-airefi(1)=sum(aire(1:ii,1))
-airefi(klon_glo)=sum(aire(1:ii,jj+1))
-
-! Sanity check: do total planet area match between physics and dynamics?
-total_area_dyn=sum(aire(1:ii,1:jj+1))
-total_area_phy=sum(airefi(1:klon_glo))
-IF (total_area_dyn/=total_area_phy) THEN
-  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
-  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
-  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
-  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
-    ! stop here if the relative difference is more than 0.001%
-    abort_message = 'planet total surface discrepancy'
-    CALL abort_gcm(modname, abort_message, 1)
-  ENDIF
-ENDIF
-
-
-!$OMP PARALLEL 
-! Now generate local lon/lat/cu/cv/area arrays
-call initcomgeomphy
-
-!!!!$OMP PARALLEL PRIVATE(ibegin,iend) & 
-!!!	!$OMP SHARED(airefi,cufi,cvfi,lonfi,latfi)
-
-offset=klon_mpi_begin-1
-airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
-cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
-cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
-
-! copy over preff , ap() and bp() 
-call ini_planete_mod(nlayer,preff,ap,bp)
-
-! copy some fundamental parameters to physics 
-! and do some initializations 
-call inifis(klon_omp,nlayer,nqtot,pdayref,punjours,ptimestep, &
-            rlatd,rlond,airephy,prad,pg,pr,pcpp)
-
-!$OMP END PARALLEL
-
-
-end subroutine iniphysiq
Index: unk/LMDZ.GENERIC/libf/phystd/kcm1d.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/kcm1d.F90	(revision 1402)
+++ 	(revision )
@@ -1,372 +1,0 @@
-program kcm1d
-
-  use infotrac, only: nqtot
-  use radinc_h,      only: NAERKIND
-  use radcommon_h,   only: L_NSPECTI, L_NSPECTV, sigma
-  use watercommon_h, only: mH2O
-  use ioipsl_getincom, only: getin
-  use comsaison_h, only: mu0, fract, dist_star
-  use planete_mod
-!  use control_mod
-  use comcstfi_mod
-  implicit none
-
-  !==================================================================
-  !     
-  !     Purpose
-  !     -------
-  !     Run the universal model radiative transfer once in a 1D column.
-  !     Useful for climate evolution studies etc.
-  !     
-  !     It can be compiled with a command like (e.g. for 25 layers):
-  !                                  "makegcm -p std -d 25 kcm1d"
-  !     It requires the files "callphys.def", "gases.def"
-  !     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
-  !
-  !     Authors
-  !     -------
-  !     R. Wordsworth
-  !
-  !==================================================================
-
-#include "dimensions.h"
-!#include "dimphys.h"
-
-  ! --------------------------------------------------------------
-  !  Declarations
-  ! --------------------------------------------------------------
-
-  integer nlayer,nlevel,nq
-  integer ilay,ilev,iq,iw,iter
-  real play(llm)     ! Pressure at the middle of the layers [Pa]
-  real zlay(llm)     ! Altitude at middle of the layers [km]
-  real plev(llm+1)   ! Intermediate pressure levels [Pa]
-  real temp(llm)     ! temperature at the middle of the layers [K]
-  real,allocatable :: q(:,:)   ! tracer mixing ratio [kg/kg]
-  real,allocatable :: vmr(:,:) ! tracer mixing ratio [mol/mol]
-  real,allocatable :: qsurf(:)        ! tracer surface budget [kg/kg] ????
-  real psurf,psurf_n,tsurf      
-
-  real emis, albedo
-
-  real muvar(llm+1)
-
-  real dtsw(llm) ! heating rate (K/s) due to SW
-  real dtlw(llm) ! heating rate (K/s) due to LW
-  real fluxsurf_lw   ! incident LW flux to surf (W/m2)
-  real fluxtop_lw    ! outgoing LW flux to space (W/m2)
-  real fluxsurf_sw   ! incident SW flux to surf (W/m2)
-  real fluxabs_sw    ! SW flux absorbed by planet (W/m2)
-  real fluxtop_dn    ! incident top of atmosphere SW flux (W/m2)
-
-  ! not used
-  real reffrad(llm,naerkind)
-  real nueffrad(llm,naerkind)
-  real cloudfrac(llm)
-  real totcloudfrac
-  real tau_col
-
-  real dTstrat
-  real aerosol(llm,naerkind) ! aerosol tau (kg/kg)
-  real OLR_nu(1,L_NSPECTI)
-  real OSR_nu(1,L_NSPECTV)
-  real Eatmtot
-
-  integer ierr
-  logical firstcall,lastcall,global1d
-
-  character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
-
-  ! --------------
-  ! Initialisation
-  ! --------------
-
-  pi=2.E+0*asin(1.E+0)
-
-  reffrad(:,:)  = 0.0
-  nueffrad(:,:) = 0.0
-  cloudfrac(:)  = 0.0
-  totcloudfrac  = 0.0
-
-
-  nlayer=llm
-  nlevel=nlayer+1
-
-  !! this is defined in comsaison_h
-  ALLOCATE(mu0(1))
-  ALLOCATE(fract(1))
-
-
-
-  !  Load parameters from "run.def" 
-  ! -------------------------------
-
-  ! check if 'kcm1d.def' file is around (otherwise reading parameters
-  ! from callphys.def via getin() routine won't work.)
-  open(90,file='kcm1d.def',status='old',form='formatted',&
-       iostat=ierr)
-  if (ierr.ne.0) then
-     write(*,*) 'Cannot find required file "kcm1d.def"'
-     write(*,*) '  (which should contain some input parameters'
-     write(*,*) '   along with the following line:'
-     write(*,*) '   INCLUDEDEF=callphys.def'
-     write(*,*) '   )'
-     write(*,*) ' ... might as well stop here ...'
-     stop
-  else
-     close(90)
-  endif
-
-! now, run.def is needed anyway. so we create a dummy temporary one
-! for ioipsl to work. if a run.def is already here, stop the
-! program and ask the user to do a bit of cleaning
-  open(90,file='run.def',status='old',form='formatted',& 
-       iostat=ierr)
-  if (ierr.eq.0) then
-     close(90)
-     write(*,*) 'There is already a run.def file.'
-     write(*,*) 'This is not compatible with 1D runs.'
-     write(*,*) 'Please remove the file and restart the run.'
-     write(*,*) 'Runtime parameters are supposed to be in kcm1d.def'
-     stop
-  else
-     call system('touch run.def')
-     call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
-     call system("echo 'INCLUDEDEF=kcm1d.def' >> run.def")
-  endif
-
-  global1d = .false. ! default value
-  call getin("global1d",global1d)
-  if(.not.global1d)then
-     print*,'Error, kcm1d must have global1d=.true. in kcm1d.def!'
-     stop
-  end if
-
-  psurf_n=100000. ! default value for psurf
-  print*,'Dry surface pressure (Pa)?'
-  call getin("psurf",psurf_n)
-  write(*,*) " psurf = ",psurf_n
-
-! OK. now that run.def has been read once -- any variable is in memory.
-! so we can dump the dummy run.def
-  call system("rm -rf run.def")
-
-  tsurf=300.0 ! default value for tsurf
-  print*,'Surface temperature (K)?'
-  call getin("tref",tsurf)
-  write(*,*) " tsurf = ",tsurf
-
-  g=10.0 ! default value for g
-  print*,'Gravity ?'
-  call getin("g",g)
-  write(*,*) " g = ",g
-
-  periastr = 1.0
-  apoastr  = 1.0
-  print*,'Periastron (AU)?'
-  call getin("periastr",periastr)
-  write(*,*) "periastron = ",periastr
-  dist_star = periastr 
-  fract     = 0.5
-  print*,'Apoastron (AU)?'
-  call getin("apoastr",apoastr)
-  write(*,*) "apoastron = ",apoastr
-
-  albedo=0.2 ! default value for albedo
-  print*,'Albedo of bare ground?'
-  call getin("albedo",albedo)
-  write(*,*) " albedo = ",albedo
-
-  emis=1.0 ! default value for emissivity
-  PRINT *,'Emissivity of bare ground ?'
-  call getin("emis",emis)
-  write(*,*) " emis = ",emis
-
-  pceil=100.0 ! Pascals
-  PRINT *,'Ceiling pressure (Pa) ?'
-  call getin("pceil",pceil)
-  write(*,*) " pceil = ", pceil
-
-  mugaz=0.
-  cpp=0.
-
-  check_cpp_match = .false.
-  call getin("check_cpp_match",check_cpp_match)
-  if (check_cpp_match) then
-     print*,"In 1D modeling, check_cpp_match is supposed to be F"
-     print*,"Please correct callphys.def"
-     stop
-  endif
-
-  call su_gases
-  call calc_cpp_mugaz
-
-  call inifis(1,llm,0,86400.0,1.0,0.0,0.0,1.0,rad,g,r,cpp)
-
-  ! Tracer initialisation
-  ! ---------------------
-  if (tracer) then
-     ! load tracer names from file 'traceur.def'
-     open(90,file='traceur.def',status='old',form='formatted',&
-          iostat=ierr)
-     if (ierr.eq.0) then
-        write(*,*) "kcm1d: Reading file traceur.def"
-        ! read number of tracers:
-        read(90,*,iostat=ierr) nq
-        if (ierr.ne.0) then
-           write(*,*) "kcm1d: error reading number of tracers"
-           write(*,*) "   (first line of traceur.def) "
-           stop
-        endif
-        nqtot=nq
-        ! allocate arrays which depend on number of tracers
-        allocate(nametrac(nq))
-        allocate(q(nlayer,nq))
-        allocate(vmr(nlayer,nq))
-        allocate(qsurf(nq))
-
-        do iq=1,nq
-           ! minimal version, just read in the tracer names, 1 per line
-           read(90,*,iostat=ierr) nametrac(iq)
-           if (ierr.ne.0) then
-              write(*,*) 'kcm1d: error reading tracer names...'
-              stop
-           endif
-        enddo !of do iq=1,nq
-     endif
-
-     call initracer(1,nq,nametrac)
-
-  endif
-
-
-  do iq=1,nq
-     do ilay=1,nlayer
-        q(ilay,iq) = 0.
-     enddo
-  enddo
-
-  do iq=1,nq
-     qsurf(iq) = 0.
-  enddo
-
-  firstcall = .true.
-  lastcall  = .false.
-
-  iter    = 1
-  Tstrat  = 150.0
-  dTstrat = 1000.0
-
-  ! ---------
-  ! Run model
-  ! ---------
-  !do
-     psurf = psurf_n
-
-     !    Create vertical profiles
-     call kcmprof_fn(nlayer,psurf,qsurf(1),tsurf,    &
-          tstrat,play,plev,zlay,temp,q(:,1),muvar(1))
-
-     !    Run radiative transfer
-     call callcorrk(1,nlayer,q,nq,qsurf,      &
-          albedo,emis,mu0,plev,play,temp,                    &
-          tsurf,fract,dist_star,aerosol,muvar,         &
-          dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
-          fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,reffrad,nueffrad,tau_col,  &
-          cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
-
-     !    Iterate stratospheric temperature
-     print*,'Tstrat = ',Tstrat
-     dTstrat = Tstrat
-     !Tstrat  = Tsurf*(0.2786*(psurf/100000.)**(-1.123))**0.25 
-     ! skin temperature (gray approx.) using analytic pure H2 expression
-     !Tstrat  = (fluxabs_sw/(2*sigma))**0.25 ! skin temperature (gray approx.)
-     Tstrat  = (fluxtop_lw/(2*sigma))**0.25 ! skin temperature (gray approx.)
-     dTstrat = dTstrat-Tstrat
-
-     !if(abs(dTstrat).lt.1.0)then
-     !   print*,'dTstrat = ',dTstrat
-     !   exit
-     !endif
-
-     !iter=iter+1
-     !if(iter.eq.100)then
-     !   print*,'Stratosphere failed to converge after'
-     !   print*,'100 iteration, aborting run.'
-     !   call abort
-     !endif
-
-  !end do
-
-  ! Run radiative transfer one last time to get OLR,OSR
-  firstcall=.false.
-  lastcall=.true.
-  call callcorrk(1,nlayer,q,nq,qsurf,      &
-       albedo,emis,mu0,plev,play,temp,                    &
-       tsurf,fract,dist_star,aerosol,muvar,         &
-       dtlw,dtsw,fluxsurf_lw,fluxsurf_sw,fluxtop_lw,    &
-       fluxabs_sw,fluxtop_dn,OLR_nu,OSR_nu,             &
-       reffrad,nueffrad,tau_col,  &
-       cloudfrac,totcloudfrac,.false.,firstcall,lastcall)
-
-
-  ! Calculate total atmospheric energy
-  Eatmtot=0.0
-  !  call calcenergy_kcm(nlayer,tsurf,temp,play,plev,qsurf,&
-  !     q(:,1),muvar,Eatmtot)
-
-  ! ------------------------
-  ! Save data to ascii files
-  ! ------------------------
-
-  print*,'Saving profiles...'
-  open(115,file='profpres.out',form='formatted')
-  open(116,file='proftemp.out',form='formatted')
-  open(117,file='profztab.out',form='formatted')
-  open(118,file='profqvar.out',form='formatted')
-  open(119,file='profvvar.out',form='formatted')
-
-  write(115,*) psurf
-  write(116,*) tsurf
-  write(117,*) 0.0
-  write(118,*) qsurf(1)
-  write(119,*) qsurf(1)*(muvar(1)/mH2O)
-  do ilay=1,nlayer
-     vmr(ilay,1) = q(ilay,1)*(muvar(ilay+1)/mH2O)
-     write(115,*) play(ilay)
-     write(116,*) temp(ilay)
-     write(117,*) zlay(ilay)
-     write(118,*) q(ilay,1)
-     write(119,*) vmr(ilay,1)
-  enddo
-  close(115)
-  close(116)
-  close(117)
-  close(118)
-  close(119)
-
-  print*, tsurf,psurf,fluxtop_dn,fluxabs_sw,fluxtop_lw 
-
-  print*,'Saving scalars...'
-  open(116,file='surf_vals.out')
-  write(116,*) tsurf,psurf,fluxtop_dn,         &
-       fluxabs_sw,fluxtop_lw 
-  close(116)
-  open(111,file='ene_vals.out')
-  write(111,*) tsurf,psurf,Eatmtot,Tstrat
-  close(111)
-
-  print*,'Saving spectra...'
-  open(117,file='OLRnu.out')
-  do iw=1,L_NSPECTI
-     write(117,*) OLR_nu(1,iw)
-  enddo
-  close(117)
-
-  open(127,file='OSRnu.out')
-  do iw=1,L_NSPECTV
-     write(127,*) OSR_nu(1,iw)
-  enddo
-  close(127)  
-
-end program kcm1d
Index: unk/LMDZ.GENERIC/libf/phystd/kcmprof_fn.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/kcmprof_fn.F90	(revision 1402)
+++ 	(revision )
@@ -1,389 +1,0 @@
-subroutine kcmprof_fn(nlayer,psurf_rcm,qsurf_rcm,Tsurf_rcm,Tstra_rcm,P_rcm,Pl_rcm,z_rcm,T_rcm,q_rcm,m_rcm)
-
-use params_h
-use watercommon_h, only : mH2O
-use gases_h
-use comcstfi_mod, only: mugaz, cpp, g
-use callkeys_mod, only: co2cond
-implicit none
-
-!     ----------------------------------------------------------------
-!     Purpose: create profiles of T, rho_v, rho_n, Pv and Pn following 
-!              Kasting 1988
-!     Authour: Adapted from a code by E. Marcq by R. Wordsworth (2011)
-!     ----------------------------------------------------------------
-
-  integer ilay, nlay
-  parameter (nlay=10000) ! number of vertical layers
-
-  ! rcm inputs
-  integer nlayer
-  real Tsurf_rcm,Tstra_rcm
-
-  ! rcm outputs
-  real psurf_rcm,qsurf_rcm
-  real P_rcm(1:nlayer)
-  real Pl_rcm(1:nlayer+1)
-  real z_rcm(1:nlayer)
-  real T_rcm(1:nlayer),q_rcm(1:nlayer)
-  real m_rcm(1:nlayer+1)
-
-  ! rcm for interpolation (should really use log coords?)
-  !double precision p1,p2,pnew,ilay_rcm
-
-  double precision lnp1,lnp2,lnpnew
-  real Dp_rcm, dlogp_rcm
-  integer ilay_rcm,ilev_rcm,ifinal_rcm
-
-  double precision Dz, Dp
-  double precision Ptop, dlogp, Psat_max
-  parameter (Ptop=1.0)                             ! Pressure at TOA [Pa]
-
-  double precision T(1:nlay)                       ! temperature [K]
-  double precision Ztab(1:nlay)                    ! altitude [m]
-  double precision Pv(1:nlay),Pn(1:nlay),P(1:nlay) ! pressure [Pa]
-  double precision rho_v(1:nlay), rho_n(1:nlay)    ! density [kg m^-3]
-  double precision a_v(1:nlay)                     ! = rho_v/rho_n [kg/kg]
-  double precision q_v(1:nlay)                     ! = rho_v/rho_tot [kg/kg]
-  double precision mtot(1:nlay)                    ! = (rho_v+rho_n)/(n_v+n_n) [g/mol]
-
-  integer profil_flag(1:nlay) ! 0 = dry, 1 = moist, 2 = isothermal
-
-  ! inputs
-  double precision Tsurf   ! surface temperature [K]
-  double precision Psurf_v ! surface par. pressure (variable species) [Pa]
-  double precision Psurf_n ! surface par. pressure (incondensible species)[Pa]
-  double precision Ttop    ! stratospheric temperature [K]
-
-  double precision dTdp        ! [K/Pa]
-  double precision dPvdp,dPndp ! [Pa/Pa]
-  double precision psat_v      ! local Psat_H2O value
-  double precision Tcrit       ! Critical temperature [K]
-  double precision rho_vTEMP,rho_nTEMP
-
-  double precision TCO2cond ! for CO2 condensation quasi-hack
-
-  ! variables necessary for steam.f90
-  double precision rhol,rhov,nul
-
-  ! for output
-  double precision vmr
-
-  logical verbose
-  parameter(verbose=.true.)
-
-  logical add_Pvar_to_total
-  parameter(add_Pvar_to_total=.true.)
-
-  ! initialise flags
-  profil_flag(:) = 0
-
-  !-------------------------------
-  ! assign input variables
-  m_n     = dble(mugaz/1000.)
-  cp_n    = cpp
-  ! modify/generalise later??
-
-  Psat_max = 1000000.0 ! maximum vapour pressure [Pa]
-                       ! set huge until further notice 
-
-  if(vgas.lt.1)then
-     if(psat_max.gt.0.0)then
-        print*,'Must have Psat_max=0 if no variable species'
-        psat_max=0.0
-        !stop
-     endif
-     print*, 'Assuming pure atmosphere'
-     m_v   = 1.0
-     tcrit = 1000.0
-  elseif(trim(gnom(vgas)).eq.'H2O')then
-     m_v   = dble(mH2O/1000.)
-     tcrit = 6.47d2
-  elseif(trim(gnom(vgas)).eq.'NH3')then
-     m_v   = 17.031/1000.
-     tcrit = 4.06d2
-  elseif(trim(gnom(vgas)).eq.'CH4')then
-     m_v   = 16.04/1000.
-     tcrit = 1.91d2
-     stop
-  else
-     print*,'Variable gas not recognised!'
-     call abort
-  endif
-
-  rmn     = rc/m_n
-  Ttop    = dble(Tstra_rcm)
-  Tsurf   = dble(Tsurf_rcm)
-
-  psat_v  = psat_max
-  if(vgas.gt.0)then
-     if(trim(gnom(vgas)).eq.'H2O')then
-        call Psat_H2O(tsurf,psat_v)
-     elseif(trim(gnom(vgas)).eq.'NH3')then
-        call Psat_NH3(tsurf,psat_v)
-     endif
-  endif
-
-  ! Moist adiabat unless greater than or equal to psat_max
-  if(psat_v*1d6.lt.psat_max)then
-    Psurf_v = Psat_v*1d6
-    profil_flag(1) = 1
-  else 
-    Psurf_v = psat_max
-    profil_flag(1) = 0
-  endif
-
-  if(add_Pvar_to_total)then
-    Psurf_n = dble(psurf_rcm)
-    psurf_rcm = real(Psurf_n+Psurf_v)
-  else
-    Psurf_n = dble(psurf_rcm) - Psurf_v
-  endif
-
-  ! include relative humidity option
-  !if(satval.lt.1.0)then
-  !   Psurf_v = Psurf_v*satval
-  !   profil_flag(1) = 0     
-  !endif
-
-  if(verbose)then
-     print*,'Psat_v  =',psat_v*1d6
-     print*,'Tsurf   =',Tsurf,' K'
-     print*,'Ttop    =',Ttop,' K'
-     print*,'Psurf_v =',Psurf_v,' Pa'
-     print*,'Psurf_n =',Psurf_n,' Pa'
-     print*,'m_n     =',m_n,' kg/mol'
-     print*,'m_v     =',m_v,' kg/mol'
-     print*,'rc      =',rc
-  endif
-
-  ! define fine pressure grid
-  dlogp_rcm = -(log(psurf_rcm)-log(ptop))/nlayer
-
-  P_rcm(1)  = psurf_rcm*exp(dlogp_rcm)
-  do ilay_rcm=1,nlayer-1
-     P_rcm(ilay_rcm+1) = P_rcm(ilay_rcm)*exp(dlogp_rcm)
-  enddo
-
-  Pl_rcm(1) = psurf_rcm
-  do ilev_rcm=2,nlayer
-     ! log-linear interpolation
-     Pl_rcm(ilev_rcm) = exp( log( P_rcm(ilev_rcm)*P_rcm(ilev_rcm-1) )/2 )
-  enddo
-
-  !-------------------------------
-  ! Layer 1
-  T(1)     = Tsurf
-  Pv(1)    = Psurf_v
-  Pn(1)    = Psurf_n
-  rho_n(1) = m_n*Pn(1)/(Rc*Tsurf)
-  rho_v(1) = m_v*Pv(1)/(Rc*Tsurf)
-  a_v(1)   = rho_v(1)/rho_n(1)
-
-  ! log pressure grid spacing (constant)
-  dlogp = -(log(Pn(1)+Pv(1))-log(ptop))/(nlay-1)
-
-  call gradients_kcm(profil_flag(1),rho_v(1),rho_n(1),Tsurf,dTdp,dPvdp,dPndp)
-  if(verbose)then
-     print*, 'dT/dp ground [K/Pa] =',dTdp
-  endif
-
-  ! initial delta p, delta z
-  Dp = (Pn(1) + Pv(1))*(exp(dlogp) - 1d0)
-  Dz = -Dp/(  g*(rho_n(1) + rho_v(1))  )
-
-  !-------------------------------
-  ! Layer 2
-  T(2)     = tsurf + dTdp*Dp 
-  Pv(2)    = Pv(1) + dPvdp*Dp
-  Pn(2)    = Pn(1) + dPndp*Dp
-  rho_n(2) = m_n*Pn(2)/(Rc*T(2))
-  rho_v(2) = m_v*Pv(2)/(Rc*T(2))
-  a_v(2)   = rho_v(2)/rho_n(2)
-
-  !-------------------------------
-  ! start vertical ascent
-  Ztab(1) = 0.
-  do ilay=2,nlay-1
-
-     ! calculate altitude levels (for diagnostic only)
-     Dz         = -Dp/(  g*(rho_n(ilay) + rho_v(ilay))  )
-     Ztab(ilay) = Dz + Ztab(ilay-1)
-
-     ! 1st assume next layer same as last one
-     profil_flag(ilay) = profil_flag(ilay-1)
-  
-     ! update delta p
-     Dp = (Pn(ilay)+Pv(ilay))*(exp(dlogp) - 1d0)
-
-     ! intial gradients call to calculate temperature at next level
-     call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
-                        T(ilay),dTdp,dPvdp,dPndp)
-
-     T(ilay+1) = T(ilay) + dTdp*Dp
-
-     ! test for moist adiabat at next level
-     psat_v=psat_max
-
-     if(vgas.gt.0)then
-     if(trim(gnom(vgas)).eq.'H2O')then
-        call Psat_H2O(T(ilay+1),psat_v)
-     elseif(trim(gnom(vgas)).eq.'NH3')then
-        call Psat_NH3(T(ilay+1),psat_v)
-     endif
-     endif
-
-     if (psat_v*1d6 .lt. Pv(ilay)+dPvdp*Dp) then
-        profil_flag(ilay)=1
-        call gradients_kcm(profil_flag(ilay),rho_v(ilay),rho_n(ilay),&
-                         T(ilay),dTdp,dPvdp,dPndp)
-     endif
-
-     ! test for stratosphere at next level
-     if (T(ilay+1) .le. Ttop) then
-        profil_flag(ilay)=2
-        T(ilay+1)=Ttop
-     endif
-
-     ! calculate pressures at next level
-     Pn(ilay+1) = Pn(ilay) + dPndp*Dp
-     Pv(ilay+1) = Pv(ilay) + dPvdp*Dp
-
-     if(profil_flag(ilay) .eq. 1)then
-       
-        psat_v=psat_max 
-
-        if(vgas.gt.0)then
-        if(trim(gnom(vgas)).eq.'H2O')then
-           call Psat_H2O(T(ilay+1),psat_v)
-        elseif(trim(gnom(vgas)).eq.'NH3')then
-           call Psat_NH3(T(ilay+1),psat_v)
-        endif
-        endif
-
-        if(Pv(ilay+1) .lt. psat_v*1e6)then
-           Pv(ilay+1)=psat_v*1d6
-        endif
-
-     endif
-
-     ! calculate gas densities at next level (assume ideal)
-     rho_n(ilay+1) = m_n*Pn(ilay+1)/(rc*T(ilay+1)) 
-     select case(profil_flag(ilay)) 
-     case(2) ! isothermal
-        rho_v(ilay+1) = rho_v(ilay)/rho_n(ilay)*rho_n(ilay+1)
-     case(1) ! moist
-
-        ! dont think this is necessary
-        !call psat_est(T(ilay+1),psat_v)
-        ! modify for ammonia!!!
-
-        rho_v(ilay+1) = m_v*psat_v*1d6/(rc*T(ilay+1))
-     case(0) ! dry
-        rho_v(ilay+1) = m_v*Pv(ilay+1)/(rc*T(ilay+1)) 
-     end select
-
-  enddo
-
-  Ztab(nlay)=Ztab(nlay-1)+Dz
-
-  !-------------------------------
-  ! save to kcm1d variables 
-
-  ! surface quantities
-  psurf_rcm = Pn(1) + Pv(1)
-  qsurf_rcm = rho_v(1)/(rho_v(1) + rho_n(1))
-
-  ! create q_v, mtot for saving
-  do ilay=1,nlay
-     mtot(ilay) = 1d3*(rho_v(ilay) + rho_n(ilay)) / &
-                  (rho_v(ilay)/m_v + rho_n(ilay)/m_n)
-     q_v(ilay)  = rho_v(ilay)/(rho_v(ilay) + rho_n(ilay))
-     ! CHECK THIS
-  enddo
-
-
-  ! convert to rcm lower-res grid
-  z_rcm(:) = 0.0
-  T_rcm(:) = 0.0
-  q_rcm(:) = 0.0
-  m_rcm(:) = 0.0
-
-  m_rcm(1) = real( 1d3*(rho_v(1) + rho_n(1)) / &
-                  (rho_v(1)/m_v + rho_n(1)/m_n) )
-
-  ilay_rcm=1
-  do ilay=2,nlay
-
-     if(ilay_rcm.le.nlayer)then
-     ! interpolate rcm variables
-
-        if(Pn(ilay)+Pv(ilay) .lt. P_rcm(ilay_rcm))then
-
-           if(ilay.eq.1)then
-              print*,'Error in create_profils: Psurf here less than Psurf in RCM!'
-              call abort
-           endif
-
-           lnp1   = log(Pn(ilay-1)+Pv(ilay-1))
-           lnp2   = log(Pn(ilay)+Pv(ilay))
-           lnpnew = dble(log(P_rcm(ilay_rcm)))
-
-           z_rcm(ilay_rcm) = real(Ztab(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
-                             + Ztab(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
-           T_rcm(ilay_rcm) = real(T(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
-                             + T(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
-           q_rcm(ilay_rcm) = real(q_v(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
-                             + q_v(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
-
-           m_rcm(ilay_rcm+1) = real(mtot(ilay-1)*(lnp2-lnpnew)/(lnp2-lnp1) &
-                             + mtot(ilay)*(lnpnew-lnp1)/(lnp2-lnp1))
-
-           ilay_rcm = ilay_rcm+1
-        endif
-
-     endif
-  enddo
-
-  ifinal_rcm=ilay_rcm-1
-  if(ifinal_rcm.lt.nlayer)then
-     if(verbose)then
-        print*,'Interpolation in kcmprof stopped at layer',ilay_rcm,'!'
-     endif
-
-     do ilay_rcm=ifinal_rcm+1,nlayer
-
-        z_rcm(ilay_rcm) = z_rcm(ilay_rcm-1)
-        T_rcm(ilay_rcm) = T_rcm(ilay_rcm-1)
-        q_rcm(ilay_rcm) = q_rcm(ilay_rcm-1)
-        m_rcm(ilay_rcm+1) = m_rcm(ilay_rcm)
-
-     enddo
-  endif
-
-  do ilay=2,nlayer
-     if(T_rcm(ilay).lt.Ttop)then
-        T_rcm(ilay)=Ttop
-     endif
-  enddo
-
-!    CO2 condensation 'haircut' of temperature profile if necessary
-  if(co2cond)then
-     print*,'CO2 condensation haircut - assumes CO2-dominated atmosphere!'
-     do ilay=2,nlayer
-        if(P_rcm(ilay).lt.518000.)then
-           TCO2cond = (-3167.8)/(log(.01*P_rcm(ilay))-23.23) ! Fanale's formula
-        else
-           TCO2cond = 684.2-92.3*log(P_rcm(ilay))+4.32*log(P_rcm(ilay))**2 
-           ! liquid-vapour transition (based on CRC handbook 2003 data)
-        endif
-
-        print*,'p=',P_rcm(ilay),', T=',T_rcm(ilay),' Tcond=',TCO2cond
-        if(T_rcm(ilay).lt.TCO2cond)then
-           T_rcm(ilay)=TCO2cond
-        endif
-     enddo
-  endif
-
-  return
-end subroutine kcmprof_fn
Index: unk/LMDZ.GENERIC/libf/phystd/lect_start_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/lect_start_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,1495 +1,0 @@
-      SUBROUTINE lect_start_archive(ngrid,nlayer,
-     &     date,tsurf,tsoil,emis,q2,
-     &     t,ucov,vcov,ps,h,phisold_newgrid,
-     &     q,qsurf,surfith,nid,
-     &     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
-
-!      USE surfdat_h
-      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
-      USE tracer_h, ONLY: igcm_co2_ice
-      USE infotrac, ONLY: tname, nqtot
-      USE slab_ice_h, ONLY: noceanmx
-!      USE control_mod
-! to use  'getin'
-      USE callkeys_mod, ONLY: ok_slab_ocean
-
-c=======================================================================
-c
-c
-c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
-c   ------
-c
-c
-c   Objet:     Lecture des variables d'un fichier "start_archive"
-c              Plus besoin de régler ancienne valeurs grace
-c              a l'allocation dynamique de memoire (Yann Wanherdrick)
-c
-c
-c
-c=======================================================================
-
-      implicit none
-
-#include "dimensions.h"
-!#include "dimphys.h"
-!#include "planete.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-!#include "control.h"
-!#include "logic.h"
-#include "ener.h"
-#include "temps.h"
-#include "netcdf.inc"
-!#include"advtrac.h"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-      INTEGER,INTENT(IN) :: ngrid, nlayer
-
-c Old variables dimensions (from file)
-c------------------------------------
-      INTEGER   imold,jmold,lmold,nsoilold,nqold
-
-
-c Variables pour les lectures des fichiers "ini" 
-c--------------------------------------------------
-!      INTEGER sizei,
-      integer timelen,dimid
-!      INTEGER length
-!      parameter (length = 100)
-      INTEGER tab0
-      INTEGER isoil,iq,iqmax
-      CHARACTER*2   str2
-
-!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
-
-!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
-
-!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
-!      CHARACTER*120 dimsource
-!      CHARACTER*16 dimname
-!      CHARACTER*80 dimtitle
-!      CHARACTER*40 dimunits
-!      INTEGER   dimtype
-
-!      INTEGER dimord(4)  ! tableau contenant l''ordre
-!      data dimord /1,2,3,4/ ! de sortie des dimensions
-
-!      INTEGER vardim(4)
-      REAL date
-      INTEGER   memo
-!      character (len=50) :: tmpname
-
-c Variable histoire 
-c------------------
-      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
-      REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm)
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-
-c!-*-
-!      integer klatdat,klongdat
-!      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-
-c variable physique
-c------------------
-      REAL tsurf(ngrid) ! surface temperature
-      REAL tsoil(ngrid,nsoilmx) ! soil temperature
-      REAL co2ice(ngrid) ! CO2 ice layer
-      REAL emis(ngrid)
-      REAL q2(ngrid,llm+1),qsurf(ngrid,nqtot)
-      REAL tslab(ngrid,noceanmx)
-      REAL rnat(ngrid),pctsrf_sic(ngrid)
-      REAL tsea_ice(ngrid),sea_ice(ngrid)
-c     REAL phisfi(ngrid)
-
-      INTEGER i,j,l
-      INTEGER nid,nvarid
-c     REAL year_day,periheli,aphelie,peri_day
-c     REAL obliquit,z0,emin_turb,lmixmin
-c     REAL emissiv,emisice(2),albedice(2)
-c     REAL iceradius(2) , dtemisice(2)
-
-      integer ierr
-      integer, dimension(4) :: start,count
-
-c Variable nouvelle grille naturelle au point scalaire
-c------------------------------------------------------
-      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
-      REAL phisold_newgrid(iip1,jjp1)
-      REAL t(iip1,jjp1,llm)
-      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
-      real inertiedatS(iip1,jjp1,nsoilmx)
-      real co2iceS(iip1,jjp1)
-      real emisS(iip1,jjp1)
-      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
-      real tslabS(iip1,jjp1,noceanmx)
-      real pctsrf_sicS(iip1,jjp1),tsea_iceS(iip1,jjp1)
-      real rnatS(iip1,jjp1), sea_iceS(iip1,jjp1)
-
-      real ptotal, co2icetotal
-
-c Var intermediaires : vent naturel, mais pas coord scalaire
-c-----------------------------------------------------------
-      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
-
-
-c Variable de l'ancienne grille 
-c---------------------------------------------------------
-
-      real, dimension(:), allocatable :: timelist
-      real, dimension(:), allocatable :: rlonuold, rlatvold
-      real, dimension(:), allocatable :: rlonvold, rlatuold
-      real, dimension(:), allocatable :: apsold,bpsold
-      real, dimension(:), allocatable :: mlayerold
-      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
-      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
-      real, dimension(:,:,:),allocatable :: tsoiloldnew
-! tsoiloldnew: old soil values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatold
-! inertiedatoldnew: old inertia values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatoldnew
-      real, dimension(:,:), allocatable :: psold,phisold
-      real, dimension(:,:), allocatable :: co2iceold
-      real, dimension(:,:), allocatable :: tsurfold
-      real, dimension(:,:), allocatable :: emisold
-      real, dimension(:,:,:,:), allocatable :: qold
-      real, dimension(:,:,:), allocatable :: tslabold
-      real, dimension(:,:), allocatable :: rnatold,pctsrf_sicold
-      real, dimension(:,:), allocatable :: tsea_iceold,sea_iceold
-
-
-      real tab_cntrl(100)
-
-      real ptotalold, co2icetotalold
-
-      logical :: olddepthdef=.false. ! flag
-! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
-      logical :: depthinterpol=.false. ! flag
-! depthinterpol=.true. if interpolation will be requiered
-      logical :: therminertia_3D=.true. ! flag
-! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
-c Variable intermediaires iutilise pour l'extrapolation verticale 
-c----------------------------------------------------------------
-      real, dimension(:,:,:), allocatable :: var,varp1 
-      real, dimension(:), allocatable :: oldgrid, oldval
-      real, dimension(:), allocatable :: newval
-
-      real surfith(iip1,jjp1) ! surface thermal inertia
-      ! surface thermal inertia at old horizontal grid resolution
-      real, dimension(:,:), allocatable :: surfithold 
-
-      character(len=30) :: txt ! to store some text
-
-c=======================================================================
-
-! 0. Preliminary stuff
-
-
-
-!-----------------------------------------------------------------------
-! 1. Read data dimensions (i.e. size and length)
-!-----------------------------------------------------------------------
-
-! 1.2 Read the various dimension lengths of data in file 
-
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"temps",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-
-      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
-      jmold=jmold-1
-
-      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
-      imold=imold-1
-
-      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
-
-      nqold=0
-      do
-         write(str2,'(i2.2)') nqold+1
-         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
-!        write(*,*) 'q'//str2
-         if (ierr.eq.NF_NOERR) then
-            nqold=nqold+1
-         else
-            exit
-         endif
-      enddo
-
-! 1.2.1 find out the # of subsurface_layers
-      nsoilold=0 !dummy initialisation
-      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
-      if (ierr.eq.NF_NOERR) then
-        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
-	if (ierr.ne.NF_NOERR) then
-	 write(*,*)'lec_start_archive: ',
-     &              'Failed reading subsurface_layers length'
-	endif
-      else
-        write(*,*)"lec_start_archive: did not find subsurface_layers"
-      endif
-
-      if (nsoilold.eq.0) then ! 'old' archive format;
-      ! must use Tg//str2 fields to compute nsoilold
-      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
-        do
-	 write(str2,'(i2.2)') nsoilold+1
-	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
-	 if (ierr.eq.NF_NOERR) then
-	  nsoilold=nsoilold+1
-	 else
-	  exit
-	 endif
-	enddo
-      endif
-
-
-      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
-        depthinterpol=.true.
-      endif
-
-! 1.3 Report dimensions
-      
-      write(*,*) "Start_archive dimensions:"
-      write(*,*) "longitude: ",imold
-      write(*,*) "latitude: ",jmold
-      write(*,*) "altitude: ",lmold
-      write(*,*) "tracers: ",nqold
-      write(*,*) "subsurface_layers: ",nsoilold
-      if (depthinterpol) then
-      write(*,*) " => Warning, nsoilmx= ",nsoilmx
-      write(*,*) '    which implies that you want subterranean interpola
-     &tion.'
-      write(*,*) '  Otherwise, set nsoilmx -in dimphys.h- to: ',nsoilold
-      endif
-      write(*,*) "time lenght: ",timelen
-      write(*,*) 
-
-!-----------------------------------------------------------------------
-! 2. Allocate arrays to store datasets
-!-----------------------------------------------------------------------
-
-      allocate(timelist(timelen))
-      allocate(rlonuold(imold+1), rlatvold(jmold))
-      allocate(rlonvold(imold+1), rlatuold(jmold+1))
-      allocate (apsold(lmold),bpsold(lmold))
-      allocate(uold(imold+1,jmold+1,lmold))
-      allocate(vold(imold+1,jmold+1,lmold))
-      allocate(told(imold+1,jmold+1,lmold))
-      allocate(psold(imold+1,jmold+1))
-      allocate(phisold(imold+1,jmold+1))
-      allocate(qold(imold+1,jmold+1,lmold,nqtot))
-      allocate(co2iceold(imold+1,jmold+1))
-      allocate(tsurfold(imold+1,jmold+1))
-      allocate(emisold(imold+1,jmold+1))
-      allocate(q2old(imold+1,jmold+1,lmold+1))
-!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
-      allocate(tsoilold(imold+1,jmold+1,nsoilold))
-      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
-      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
-      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
-      ! surface thermal inertia at old horizontal grid resolution
-      allocate(surfithold(imold+1,jmold+1))
-      allocate(mlayerold(nsoilold))
-      allocate(qsurfold(imold+1,jmold+1,nqtot))
-      allocate(tslabold(imold+1,jmold+1,noceanmx))
-      allocate(rnatold(imold+1,jmold+1))
-      allocate(pctsrf_sicold(imold+1,jmold+1))
-      allocate(tsea_iceold(imold+1,jmold+1))
-      allocate(sea_iceold(imold+1,jmold+1))
-
-      allocate(var (imold+1,jmold+1,llm))
-      allocate(varp1 (imold+1,jmold+1,llm+1))
-
-      write(*,*) 'q2',ngrid,llm+1
-      write(*,*) 'q2S',iip1,jjp1,llm+1
-      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
-
-!-----------------------------------------------------------------------
-! 3. Read time-independent data
-!-----------------------------------------------------------------------
-
-C-----------------------------------------------------------------------
-c 3.1. Lecture du tableau des parametres du run 
-c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Lect_start_archive: 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*, "lect_start_archive: Lecture echoue pour <controle>"
-         CALL abort
-      ENDIF
-c
-      tab0 = 50
-
-c-----------------------------------------------------------------------
-c 3.2 Lecture des longitudes et latitudes
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
-         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*, "lect_start_archive: Lecture echouee pour <rlonv>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
-         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*, "lect_start_archive: Lecture echouee pour <rlatu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
-         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*, "lect_start_archive: Lecture echouee pour <rlonu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
-         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*, "lect_start_archive: Lecture echouee pour <rlatv>"
-         CALL abort
-      ENDIF
-c
-
-c-----------------------------------------------------------------------
-c 3.3. Lecture des niveaux verticaux
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "aps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <aps> est absent"
-         apsold=0
-         PRINT*, "<aps> set to 0"
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
-         ENDIF
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "bps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <bps> est absent"
-         PRINT*, "It must be an old start_archive, lets look for sig_s"
-         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "Nothing to do..."
-            CALL abort
-         ENDIF
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
-         CALL abort
-      END IF
-
-c-----------------------------------------------------------------------
-c 3.4 Read Soil layers depths
-c-----------------------------------------------------------------------
-     
-      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <soildepth>'
-       write(*,*)' => Assuming this is an archive in old format'
-       olddepthdef=.true.
-       depthinterpol=.true.
-       ! this is how soil depth was defined in ye old days
-	do isoil=1,nsoilold
-	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
-	enddo
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-
-      endif !of if(ierr.ne.NF_NOERR)
-
-      ! Read (or build) mlayer()
-      if (depthinterpol) then
-       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
-       ! as in soil_settings.F
-       write(*,*)' => Building default soil depths'
-       do isoil=0,nsoilmx-1
-         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
-       enddo
-       write(*,*)' => mlayer: ',mlayer
-       ! Also build (default) new soil interlayer depth layer(:)
-       do isoil=1,nsoilmx
-         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
-     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
-       enddo
-       write(*,*)' =>  layer: ',layer
-      else ! read mlayer() from file
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-      endif ! of if (depthinterpol)
-
-c-----------------------------------------------------------------------
-c 3.5 Read Soil thermal inertia
-c-----------------------------------------------------------------------
-
-      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <inertiedat>'
-       write(*,*)' => Assuming this is an archive in old format'
-       therminertia_3D=.false.
-       write(*,*)' => Thermal inertia will be read from reference file'
-       volcapa=1.e6
-       write(*,*)'    and soil volumetric heat capacity is set to ',
-     &           volcapa
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
-         CALL abort
-       endif
-      endif
-
-c-----------------------------------------------------------------------
-c 3.6 Lecture geopotentiel au sol
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
-         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*, "lect_start_archive: Lecture echouee pour <phisinit>"
-         CALL abort
-      ENDIF
-
-C-----------------------------------------------------------------------
-c   lecture de "ptotalold" et "co2icetotalold"
-c-----------------------------------------------------------------------
-      ptotalold = tab_cntrl(tab0+49)
-      co2icetotalold = tab_cntrl(tab0+50)
- 
-c-----------------------------------------------------------------------
-c 4. Lecture du temps et choix
-c-----------------------------------------------------------------------
- 
-c  lecture du temps
-c
-      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: Le champ <Time> est absent"
-            CALL abort
-         endif
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_VARID (nid, "temps", nvarid)
-      endif 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
-         CALL abort
-      ENDIF
-c
-      write(*,*)
-      write(*,*)
-      write(*,*) 'Differentes dates des etats initiaux stockes:'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      pi=2.*ASIN(1.)
-      do i=1,timelen
-c       call solarlong(timelist(i),sollong(i))
-c       sollong(i) = sollong(i)*180./pi
-        write(*,*) 'etat initial au jour martien' ,int(timelist(i))
-c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
-c    .    sollong(i)
-      end do
-
-   6  FORMAT(i7,i7,f9.3)
- 
-      write(*,*)
-      write(*,*) 'Choix de la date'
- 123  read(*,*,iostat=ierr) date
-      if(ierr.ne.0) goto 123
-      memo = 0
-      do i=1,timelen
-        if (date.eq.int(timelist(i))) then
-            memo = i
-        endif
-      end do
- 
-      if (memo.eq.0) then
-        write(*,*)
-        write(*,*)
-        write(*,*) 'He alors... Y sait pas lire !?!'
-        write(*,*)
-        write(*,*) 'Differentes dates des etats initiaux stockes:'
-        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-        do i=1,timelen
-          write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
-c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
-        end do
-        goto 123
-      endif
-
-!-----------------------------------------------------------------------
-! 5. Read (time-dependent) data from datafile
-!-----------------------------------------------------------------------
-
-
-c-----------------------------------------------------------------------
-c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], qsurf)
-c-----------------------------------------------------------------------
- 
-      start=(/1,1,memo,0/)
-      count=(/imold+1,jmold+1,1,0/)
-       
-! CO2ice is now in qsurf(igcm_co2_ice) ...
-!      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
-!      IF (ierr .NE. NF_NOERR) THEN
-!         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
-!         CALL abort
-!      ENDIF
-!#ifdef NC_DOUBLE
-!      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
-!#else
-!      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
-!#endif
-!      IF (ierr .NE. NF_NOERR) THEN
-!         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
-!         PRINT*, NF_STRERROR(ierr)
-!         CALL abort
-!      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "emis", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <emis> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
-         CALL abort
-      ENDIF
-c
-      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,count,psold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,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,count,tsurfold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
-         CALL abort
-      ENDIF
-c
-cc Slab ocean
-      if(ok_slab_ocean) then
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,noceanmx,1/)
-
-       ierr=NF_INQ_VARID(nid,"tslab",nvarid)
-       IF (ierr.ne.NF_NOERR) then
-          PRINT*,"lect_start_archive: Cannot find <tslab>"
-       ENDIF
-#ifdef NC_DOUBLE
-      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tslabold)
-#else
-      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tslabold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <tslab>"
-      ENDIF
-
-
-c
-      start=(/1,1,memo,0/)
-      count=(/imold+1,jmold+1,1,0/)
-
-      ierr = NF_INQ_VARID (nid, "rnat", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <rnat> est absent"
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,rnatold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,rnatold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <rnat>"
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "pctsrf_sic", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <pctsrf_sic> est absent"
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,pctsrf_sicold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,pctsrf_sicold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <pctsrf_sic>"
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "tsea_ice", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <tsea_ice> est absent"
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsea_iceold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsea_iceold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <tsea_ice>"
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "sea_ice", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <sea_ice> est absent"
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,sea_iceold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,sea_iceold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <sea_ice>"
-      ENDIF
-  
-      ENDIF! ok_slab_ocean
-c
-      write(*,*)"lect_start_archive: rlonuold:"
-     &           ,rlonuold," rlatvold:",rlatvold
-      write(*,*)
-
-! Surface tracers:      
-      do iq=1,nqtot
-        ! initialize all surface tracers to zero
-        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
-      enddo
-
-
-!      print*,'tname=',tname
-!      print*,'nid',nid
-!      print*,'nvarid',nvarid
-!      stop
-
-      DO iq=1,nqtot
-          txt=trim(tname(iq))//"_surf"
-          if (txt.eq."h2o_vap") then
-            ! There is no surface tracer for h2o_vap;
-            ! "h2o_ice" should be loaded instead
-            txt="h2o_ice_surf"
-            write(*,*) 'lect_start_archive: loading surface tracer',
-     &                     ' h2o_ice instead of h2o_vap'
-          endif
-
-        
-        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-
-!          print*,'RDW has added hack to let me continue...'
-!          CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#else
-        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#endif
-        IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "lect_start_archive: ",
-     &             " Failed loading <",trim(txt),">"
-          write (*,*) trim(txt),'    is set to 0'
-!          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-
-!-----------------------------------------------------------------------
-! 5.2 Read 3D subterranean fields
-!-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-!
-! Read soil temperatures
-!
-      if (olddepthdef) then ! tsoil stored using the 'old format'
-         start=(/1,1,memo,0/)
-         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
-       do isoil=1,nsoilold
-         write(str2,'(i2.2)') isoil
-c
-         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              "Field <","Tg"//str2,"> not found"
-            CALL abort
-         ENDIF
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#else
-         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &            "Failed reading <","Tg"//str2,">"
-            CALL abort
-         ENDIF
-c
-       enddo ! of do isoil=1,nsoilold
-      
-      ! reset 'start' and 'count' to "3D" behaviour
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-      
-      else
-       write(*,*) "lect_start_archive: loading tsoil "
-       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
-       if (ierr.ne.NF_NOERR) then
-        write(*,*)"lect_start_archive: Cannot find <tsoil>"
-	call abort
-       else
-#ifdef NC_DOUBLE
-      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
-#else
-      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
-#endif
-       endif ! of if (ierr.ne.NF_NOERR)
-       
-      endif ! of if (olddepthdef)
-
-!
-! Read soil thermal inertias
-!
-!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
-!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-!       if (ierr.ne.NF_NOERR) then
-!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
-!	call abort
-!       else
-!#ifdef NC_DOUBLE
-!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
-!#else
-!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
-!#endif
-!       endif ! of if (ierr.ne.NF_NOERR)
-!      endif
-
-c-----------------------------------------------------------------------
-c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
-c-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/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, count, told)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, 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,count,uold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,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,count,vold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
-         CALL abort
-      ENDIF
-c
-
-! Tracers:      
-      do iq=1,nqtot
-         call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
-      enddo
-
-      DO iq=1,nqtot
-        txt=tname(iq)
-        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-!            CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
-#else
-        ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
-#endif
-        IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "lect_start_archive: ",
-     &             "  Failed loading <",trim(txt),">"
-          write (*,*) trim(txt),'      set to 1.E-30'
-          do l=1,lmold
-            do j=1,jmold+1
-              do i=1,imold+1
-                 qold(i,j,l,iq)=1.e-30
-              end do
-            end do
-          end do
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-
-!=======================================================================
-! 6. Interpolation from old grid to new grid
-!=======================================================================
-
-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 6.1	Variable 2d :
-c-----------------------------------------------------------------------
-c Relief 
-      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-! CO2 ice is now in qsurf(igcm_co2_ice)
-!      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
-!     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c Temperature de surface
-      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,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,iim+1,jjm+1,ngrid,tsoils,tsoil)
-c     write(45,*) 'tsoil',tsoil
-
-c Emissivite de la surface
-      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
-c     write(46,*) 'emis',emis
-
-
-
-c-----------------------------------------------------------------------
-c 6.1.2	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-----------------------------------------------------------------------
-c	On assure la conservation de la masse de l'atmosphere + calottes
-c-----------------------------------------------------------------------
-
-      ptotal =  0.
-      DO j=1,jjp1
-         DO i=1,iim
-            ptotal=ptotal+ps(i,j)*aire(i,j)/g
-         END DO
-      END DO
-      co2icetotal = 0.
-      if (igcm_co2_ice.ne.0) then
-        ! recast surface CO2 ice on new grid
-        call interp_horiz(qsurfold(1,1,igcm_co2_ice),
-     &                  qsurfs(1,1,igcm_co2_ice),
-     &                  imold,jmold,iim,jjm,1,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-       DO j=1,jjp1
-         DO i=1,iim
-           !co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
-           co2icetotal=co2icetotal+qsurfS(i,j,igcm_co2_ice)*aire(i,j)
-         END DO
-       END DO
-      else
-        write(*,*) "Warning: No co2_ice surface tracer"
-      endif
-
-      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(*,*)
-      write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
-      write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
-      if (co2icetotalold.ne.0.) then
-      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
-      endif
-      write(*,*)
-
-
-      DO j=1,jjp1
-         DO i=1,iip1
-            ps(i,j)=ps(i,j) * ptotalold/ptotal
-         END DO
-      END DO
-
-      if ( co2icetotalold.gt.0.) then 
-!         DO j=1,jjp1
-!            DO i=1,iip1
-!               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
-!            END DO
-!         END DO
-        write(*,*) "Not enforcing conservation of surface CO2 ice"
-        write(*,*) " (should be OK when CO2 ice is a tracer)"
-      end if
-
-c-----------------------------------------------------------------------
-c 6.2 Subterranean 3d variables:
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c 6.2.1 Thermal Inertia
-c       Note: recall that inertiedat is a common in "comsoil.h"
-c-----------------------------------------------------------------------
-
-      ! depth-wise interpolation, if required
-      if (depthinterpol.and.(.not.olddepthdef)) then
-        allocate(oldval(nsoilold))
-	allocate(newval(nsoilmx))
-        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
-     &f soil thermal inertia; might be wiser to reset it.'
-        write(*,*)
-       
-        do i=1,imold+1
-         do j=1,jmold+1
-	   !copy old values
-	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
-	   !interpolate
-	   call interp_line(mlayerold,oldval,nsoilold,
-     &                     mlayer,newval,nsoilmx)
-           !copy interpolated values
-           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-        enddo
-        ! cleanup
-	deallocate(oldval)
-	deallocate(newval)
-      endif !of if (depthinterpol)
-
-      if (therminertia_3D) then
-        ! We have inertiedatold
-       if((imold.ne.iim).or.(jmold.ne.jjm)) then
-       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
-     &of thermal inertia; might be better to reset it.'
-       write(*,*)
-       endif
-       
-        ! Do horizontal interpolation
-	if (depthinterpol) then
-	  call interp_horiz(inertiedatoldnew,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-	else
-          call interp_horiz(inertiedatold,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilold,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-        endif ! of if (depthinterpol)
-
-      else ! no 3D thermal inertia data
-       write(*,*)'lect_start_archive: using reference surface inertia'
-        ! Use surface inertia (and extend it to all depths)
-        do i=1,nsoilmx
-         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
-        enddo
-	! Build an old resolution surface thermal inertia
-	! (will be needed for tsoil interpolation)
-	call interp_horiz(surfith,surfithold,
-     &                    iim,jjm,imold,jmold,1,
-     &                    rlonu,rlatv,rlonuold,rlatvold)
-      endif
-
-
-      ! Reshape inertiedatS to scalar grid as inertiedat
-      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
-     &                  inertiedatS,inertiedat)
-      
-c-----------------------------------------------------------------------
-c 6.2.2 Soil temperature
-c-----------------------------------------------------------------------
-!      write(*,*) 'Soil'
-
-      !print*,'Problem in lect_start_archive interpolating'
-      !print*,'to new resolution!!'
-
-      ! Recast temperatures along soil depth, if necessary
-      if (olddepthdef) then
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        do i=1,imold+1
-	 do j=1,jmold+1
-
-            !if(i.gt.iip1 .or. j.gt.jjp1)then
-               !print*,'Problem in lect_start_archive interpolating'
-               !print*,'to new resolution!!'
-               !call abort
-            !endif
-
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-!	   oldval(1)=tsurfS(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	   ! build vertical coordinate
-	   oldgrid(1)=0. ! ground
-	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
-     &                (surfithold(i,j)/1.e6)
-          ! Note; at this stage, we impose volcapa=1.e6 above
-	  ! since volcapa isn't set in old soil definitions
-
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-
-      else
-       if (depthinterpol) then ! if vertical interpolation is required
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        ! build vertical coordinate
-	oldgrid(1)=0. ! ground
-	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
-        do i=1,imold+1
-	 do j=1,jmold+1
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-!	   oldval(1)=tsurfS(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-       
-       else
-        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
-       endif ! of if (depthinterpol)
-      endif ! of if (olddepthdef)
-
-      ! Do the horizontal interpolation
-       call interp_horiz(tsoiloldnew,tsoilS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-      ! Reshape tsoilS to scalar grid as tsoil
-       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
-
-c-----------------------------------------------------------------------
-c 6.3   Slab Ocean :
-c-----------------------------------------------------------------------
-      call interp_horiz (tslabold,tslabs,imold,jmold,iim,jjm,noceanmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tslabs,tslab)
-
-      call interp_horiz (rnatold,rnats,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,rnats,rnat)
-
-      call interp_horiz (pctsrf_sicold,pctsrf_sics,imold,jmold,iim,
-     &                   jjm,1,rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,pctsrf_sics,pctsrf_sic)
-
-      call interp_horiz (tsea_iceold,tsea_ices,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tsea_ices,tsea_ice)
-
-      call interp_horiz (sea_iceold,sea_ices,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,sea_ices,sea_ice)
-
-c-----------------------------------------------------------------------
-c 6.4 Variable 3d :
-c-----------------------------------------------------------------------
-      
-c temperatures atmospheriques
-      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
-      call interp_vert
-     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
-     &     psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
-      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
-
-c q2 : pbl wind variance
-      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
-      call interp_vert (q2old,varp1,lmold+1,llm+1,
-     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
-      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
-      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
-      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
-c     write(47,*) 'q2',q2
-
-c calcul des champ de vent; passage en vent covariant
-      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
-      call interp_vert
-     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
-     &  psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
-      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
-
-      call interp_vert
-     & (vold,var,lmold,llm,
-     &  apsold,bpsold,aps,bps,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 (*,*) 'lect_start_archive: 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)
-c           ucov( i,j,l ) = 0
-          end do
-        end do
-      end do 
-      write (*,*) 'lect_start_archive: 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)
-c           vcov( i,j,l ) = 0
-          end do
-          vcov( iip1,j,l ) = vcov( 1,j,l )
-        end do
-      end do
-c     write(49,*) 'ucov',vcov
-
-      if (nqtot .gt. 0) then
-c traceurs surface
-      do iq = 1, nqtot
-            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
-     &                  imold,jmold,iim,jjm,1,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-
-      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
-
-c traceurs 3D
-      do  iq = 1, nqtot
-            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
-     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-cccccccccccccccccccccccccccccc      
-c  make sure that sum of q = 1      
-c dominent species is = 1 - sum(all other species)      
-cccccccccccccccccccccccccccccc      
-c      iqmax=1
-c      
-c      if (nqold.gt.10) then
-c       do l=1,llm
-c        do j=1,jjp1
-c          do i=1,iip1
-c           do iq=1,nqold
-c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
-c              iqmax=iq
-c            endif
-c           enddo
-c           q(i,j,l,iqmax)=1.
-c           qtot(i,j,l)=0
-c           do iq=1,nqold
-c            if (iq.ne.iqmax) then        
-c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
-c            endif
-c           enddo !iq
-c           do iq=1,nqold
-c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
-c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
-c     $    qtot(i,j,l)
-c           enddo !iq
-c          enddo !i   
-c         enddo !j   
-c       enddo !l  
-c      endif
-ccccccccccccccccccccccccccccccc
-
-c     Periodicite :
-      do  iq = 1, nqtot
-         do l=1, llm
-            do j = 1, jjp1
-               q(iip1,j,l,iq) = q(1,j,l,iq)
-            end do
-         end do
-      enddo
-      
-!      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
-! no need to transfer "co2ice" any more; it is in qsurf(igcm_co2_ice)
-
-      endif !! if nqtot .ne. 0
-
-c-----------------------------------------------------------------------
-c   Initialisation  h:	(passage de t -> h)
-c-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO j=1,jjp1
-            DO i=1,iim
-               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
-            END DO
-            h(iip1,j,l) =  h(1,j,l)
-         END DO
-      END DO
-
-
-c***********************************************************************
-c***********************************************************************
-c     Fin subroutine lecture ini
-c***********************************************************************
-c***********************************************************************
-
-      deallocate(timelist)
-      deallocate(rlonuold, rlatvold)
-      deallocate(rlonvold, rlatuold)
-      deallocate(apsold,bpsold)
-      deallocate(uold)
-      deallocate(vold)
-      deallocate(told)
-      deallocate(psold)
-      deallocate(phisold)
-      deallocate(qold)
-      deallocate(co2iceold)
-      deallocate(tsurfold)
-      deallocate(emisold)
-      deallocate(q2old)
-      deallocate(tsoilold)
-      deallocate(tsoiloldnew)
-      deallocate(inertiedatold)
-      deallocate(inertiedatoldnew)
-      deallocate(surfithold)
-      deallocate(mlayerold)
-      deallocate(qsurfold)
-      deallocate(var,varp1)
-      deallocate(tslabold)
-      deallocate(rnatold)
-      deallocate(pctsrf_sicold)
-      deallocate(tsea_iceold)
-      deallocate(sea_iceold)
-
-!      write(*,*)'lect_start_archive: END'
-      return
-      end
Index: unk/LMDZ.GENERIC/libf/phystd/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_grid_phy_lmdz.F90	(revision 1402)
+++ 	(revision )
@@ -1,454 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_grid_phy_lmdz
-
-  PUBLIC
-  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
-             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
-
-  INTEGER,SAVE :: nbp_lon  ! == iim
-  INTEGER,SAVE :: nbp_lat  ! == jjmp1
-  INTEGER,SAVE :: nbp_lev  ! == llm
-  INTEGER,SAVE :: klon_glo
-!$OMP THREADPRIVATE(nbp_lon,nbp_lat,nbp_lev,klon_glo)
-
-  INTERFACE grid1dTo2d_glo
-    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
-                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
-		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
-   END INTERFACE 
-
-   INTERFACE grid2dTo1d_glo
-    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
-                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
-		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
-   END INTERFACE 
- 
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
-  IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjp1
-  INTEGER, INTENT(in) :: llm
-  
-    nbp_lon=iim
-    nbp_lat=jjp1
-    nbp_lev=llm
-    klon_glo=(iim*jjp1)-2*(iim-1)
-  
-  ! Ehouarn: handle 1D case:
-  if ((iim.eq.1).and.(jjp1.eq.2)) then
-    nbp_lat=1
-    klon_glo=1
-  endif
-  
-  END SUBROUTINE init_grid_phy_lmdz
-  
-  
-  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_i
-  
-
-  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_i1
-
-  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_i2
-  
-  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_i3
-
-
-  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_r
-  
-
-  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_r1
-
-  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_r2
-  
-  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_l
-  
-
-  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_l1
-
-  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_l2
-  
-  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_l3  
-  
-    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_i
-  
-
-  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_i1
-
-  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_i2
-  
-  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_r
-  
-
-  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_r1
-
-  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_r2
-  
-  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_r3
-
-
-
-  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_l
-  
-
-  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_l1
-
-  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_l2
-  
-  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_l3
-
-!---------------------------------------------------------------- 
-!  fonctions generiques (privees)
-!---------------------------------------------------------------- 
-  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_igen   
-
-
-  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-   
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_rgen   
-
-  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_lgen     
-  
-  
-  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_igen   
-  
-  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_rgen 
-    
-  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_lgen   
-
-END MODULE mod_grid_phy_lmdz
Index: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_mpi_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,218 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_mpi_data
-  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
-  
-  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
-!!$OMP THREADPRIVATE(ii_begin,ii_end,jj_begin,jj_end,jj_nb,ij_begin,&
-!	!$OMP ij_end,ij_nb,klon_mpi_begin,klon_mpi_end,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 
-!!$OMP THREADPRIVATE(jj_para_nb,jj_para_begin,jj_para_end,ii_para_begin,ii_para_end,&
-!	!$OMP ij_para_nb,ij_para_begin,ij_para_end,klon_mpi_para_nb,klon_mpi_para_begin,&
-!	!$OMP 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
-!!$OMP THREADPRIVATE(mpi_rank,mpi_size,mpi_root,is_mpi_root,is_using_mpi)
-  
-  
-  LOGICAL,SAVE :: is_north_pole
-  LOGICAL,SAVE :: is_south_pole
-  INTEGER,SAVE :: COMM_LMDZ_PHY
-!!$OMP THREADPRIVATE(is_north_pole,is_south_pole,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
-
-      ! Ehouarn: handle 1D case:
-      if (klon_glo.eq.1) then
-        klon_mpi_para_end(i) = 1
-        klon_mpi_para_nb(i) = 1
-        ij_para_end(i) = 1
-        jj_para_end(i) = 1
-        ii_para_end(i) = 1
-      endif
-
-      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(*,*) 'ii_begin =', ii_begin
-    WRITE(*,*) 'ii_end =', ii_end
-    WRITE(*,*) 'jj_begin =',jj_begin
-    WRITE(*,*) 'jj_end =', jj_end
-    WRITE(*,*) 'jj_nb =', jj_nb
-    WRITE(*,*) 'ij_begin =', ij_begin
-    WRITE(*,*) 'ij_end =', ij_end
-    WRITE(*,*) 'ij_nb =', ij_nb
-    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
-    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
-    WRITE(*,*) 'klon_mpi =', klon_mpi
-    WRITE(*,*) 'jj_para_nb =', jj_para_nb
-    WRITE(*,*) 'jj_para_begin =', jj_para_begin
-    WRITE(*,*) 'jj_para_end =', jj_para_end
-    WRITE(*,*) 'ii_para_begin =', ii_para_begin
-    WRITE(*,*) 'ii_para_end =', ii_para_end
-    WRITE(*,*) 'ij_para_nb =', ij_para_nb
-    WRITE(*,*) 'ij_para_begin =', ij_para_begin
-    WRITE(*,*) 'ij_para_end =', ij_para_end
-    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
-    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
-    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
-    WRITE(*,*) 'mpi_rank =', mpi_rank
-    WRITE(*,*) 'mpi_size =', mpi_size
-    WRITE(*,*) 'mpi_root =', mpi_root
-    WRITE(*,*) 'is_mpi_root =', is_mpi_root
-    WRITE(*,*) 'is_north_pole =', is_north_pole
-    WRITE(*,*) 'is_south_pole =', is_south_pole
-    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
-  
-  END SUBROUTINE print_module_data
-  
-END MODULE mod_phys_lmdz_mpi_data
Index: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_mpi_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1906 +1,0 @@
-!
-!$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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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)
-    if (ierr.ne.MPI_SUCCESS) then
-      write(*,*) "bcast_mpi error: ierr=",ierr
-      stop
-    endif
-#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: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_omp_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-!$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(*,*)'--------> TASK ',omp_rank
-  WRITE(*,*)'omp_size =',omp_size
-  WRITE(*,*)'omp_rank =',omp_rank
-  WRITE(*,*)'is_omp_root =',is_omp_root
-  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
-  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
-  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
-  WRITE(*,*)'klon_omp =',klon_omp
-  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
-  WRITE(*,*)'klon_omp_end =',klon_omp_end    
-!$OMP END CRITICAL
-
-  END SUBROUTINE Print_module_data
-END MODULE mod_phys_lmdz_omp_data
Index: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_omp_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1057 +1,0 @@
-!
-!$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, only: klon_omp, klon_omp_begin
-    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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,115 +1,0 @@
-!
-!$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)
-!$OMP THREADPRIVATE(is_sequential,is_parallel)
-  
-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, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
-                               grid1dTo2d_glo, grid2dTo1d_glo
-  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(*,*) "------> 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(*,*) "------> 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(*,*) "------> Checksum =",Checksum," MUST BE 0"
-!$OMP END MASTER
-    ENDIF
-    
-     
-   END SUBROUTINE Test_transfert
-  
-END MODULE mod_phys_lmdz_para
-    
Index: unk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/mod_phys_lmdz_transfert_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,1275 +1,0 @@
-!
-!$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: unk/LMDZ.GENERIC/libf/phystd/newstart.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/newstart.F	(revision 1402)
+++ 	(revision )
@@ -1,1667 +1,0 @@
-C======================================================================
-      PROGRAM newstart
-c=======================================================================
-c
-c
-c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
-c   ------
-c             Derniere modif : 12/03
-c
-c
-c   Objet:  Create or modify the initial state for the LMD Mars GCM
-c   -----           (fichiers NetCDF start et startfi)
-c
-c
-c=======================================================================
-
-      use infotrac, only: iniadvtrac, nqtot, tname
-      USE tracer_h, ONLY: igcm_co2_ice, igcm_h2o_vap, igcm_h2o_ice
-      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, inertiedat
-      USE surfdat_h, ONLY: phisfi, albedodat,
-     &                     zmea, zstd, zsig, zgam, zthe
-      USE comgeomfi_h, ONLY: lati, long, area
-      use datafile_mod, only: datadir
-! to use  'getin'
-!      USE ioipsl_getincom, only: getin
-      USE ioipsl_getincom_p, only: getin_p
-      use control_mod, only: day_step, iphysiq, anneeref
-      use phyredem, only: physdem0, physdem1
-      use iostart, only: open_startphy
-      use comgeomphy, only: initcomgeomphy
-      use slab_ice_h, only:noceanmx
-      implicit none
-
-#include "dimensions.h"
-!#include "dimphys.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-!#include "planete.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-!#include "control.h"
-#include "logic.h"
-#include "ener.h"
-#include "temps.h"
-#include "comdissnew.h"
-#include "serre.h"
-#include "netcdf.inc"
-!#include "advtrac.h"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-c Variables dimension du fichier "start_archive"
-c------------------------------------
-      CHARACTER	relief*3
-
-
-c Variables pour les lectures NetCDF des fichiers "start_archive" 
-c--------------------------------------------------
-      INTEGER nid_dyn, nid_fi,nid,nvarid
-      INTEGER length
-      parameter (length = 100)
-      INTEGER tab0
-      INTEGER   NB_ETATMAX
-      parameter (NB_ETATMAX = 100)
-
-      REAL  date
-      REAL p_rad,p_omeg,p_g,p_cpp,p_mugaz,p_daysec
-
-c Variable histoire 
-c------------------
-      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL phis(iip1,jjp1)
-      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-      REAL pks(iip1,jjp1)
-      REAL w(iip1,jjp1,llm+1)
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
-      REAL phi(iip1,jjp1,llm)
-
-      integer klatdat,klongdat
-      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
-      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
-
-c variable physique
-c------------------
-      REAL tsurf(ngridmx)	! surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
-!      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL emis(ngridmx)	! surface emissivity
-      real emisread             ! added by RW
-      REAL,ALLOCATABLE :: qsurf(:,:)
-      REAL q2(ngridmx,llm+1)
-!      REAL rnaturfi(ngridmx)
-      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
-      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
-      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
-      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
-
-      INTEGER i,j,l,isoil,ig,idum
-      real mugaz ! molar mass of the atmosphere
-
-      integer ierr 
-
-      REAL rnat(ngridmx)
-      REAL tslab(ngridmx,nsoilmx) ! slab ocean temperature
-      REAL pctsrf_sic(ngridmx) ! sea ice cover
-      REAL tsea_ice(ngridmx) ! temperature sea_ice
-      REAL sea_ice(ngridmx) ! mass of sea ice (kg/m2)
-
-c Variables on the new grid along scalar points 
-c------------------------------------------------------
-!      REAL p(iip1,jjp1)
-      REAL t(iip1,jjp1,llm)
-      REAL tset(iip1,jjp1,llm)
-      real phisold_newgrid(iip1,jjp1)
-      REAL :: teta(iip1, jjp1, llm)
-      REAL :: pk(iip1,jjp1,llm)
-      REAL :: pkf(iip1,jjp1,llm)
-      REAL :: ps(iip1, jjp1)
-      REAL :: masse(iip1,jjp1,llm)
-      REAL :: xpn,xps,xppn(iim),xpps(iim)
-      REAL :: p3d(iip1, jjp1, llm+1)
-      REAL :: beta(iip1,jjp1,llm)
-!      REAL dteta(ip1jmp1,llm)
-
-c Variable de l'ancienne grille 
-c------------------------------
-      real time
-      real tab_cntrl(100)
-      real tab_cntrl_bis(100)
-
-c variables diverses
-c-------------------
-      real choix_1,pp
-      character*80      fichnom
-      character*250  filestring
-      integer Lmodif,iq,thermo
-      character modif*20
-      real z_reel(iip1,jjp1)
-      real tsud,albsud,alb_bb,ith_bb,Tiso,Tabove
-      real ptoto,pcap,patm,airetot,ptotn,patmn,psea
-!      real ssum
-      character*1 yes
-      logical :: flagtset=.false. ,  flagps0=.false.
-      real val, val2, val3, val4 ! to store temporary variables
-      real :: iceith=2000 ! thermal inertia of subterranean ice
-      integer iref,jref
-
-      INTEGER :: itau
-      
-      INTEGER :: nq,numvanle
-      character(len=20) :: txt ! to store some text
-      character(len=50) :: surfacefile ! "surface.nc" (or equivalent file)
-      character(len=150) :: longline
-      integer :: count
-      real :: profile(llm+1) ! to store an atmospheric profile + surface value
-
-!     added by RW for test
-      real pmean, phi0
-
-!     added by BC for equilibrium temperature startup
-      real teque
-
-!     added by BC for cloud fraction setup
-      REAL hice(ngridmx),cloudfrac(ngridmx,llm)
-      REAL totalfrac(ngridmx)
-
-
-!     added by RW for nuketharsis
-      real fact1
-      real fact2
-
-
-c sortie visu pour les champs dynamiques
-c---------------------------------------
-!      INTEGER :: visuid
-!      real :: time_step,t_ops,t_wrt
-!      CHARACTER*80 :: visu_file
-
-      cpp    = 0.
-      preff  = 0.
-      pa     = 0. ! to ensure disaster rather than minor error if we don`t
-                  ! make deliberate choice of these values elsewhere.
-
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-! allocate arrays
-      allocate(q(iip1,jjp1,llm,nqtot))
-      allocate(qsurf(ngridmx,nqtot))
-
-c=======================================================================
-c   Choice of the start file(s) to use
-c=======================================================================
-      write(*,*) 'From which kind of files do you want to create new',
-     .  'start and startfi files'
-      write(*,*) '    0 - from a file start_archive'
-      write(*,*) '    1 - from files start and startfi'
- 
-c-----------------------------------------------------------------------
-c   Open file(s) to modify (start or start_archive)
-c-----------------------------------------------------------------------
-
-      DO
-         read(*,*,iostat=ierr) choix_1
-         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
-      ENDDO
-
-c     Open start_archive
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start_archive.nc'
-        write(*,*)
-        fichnom = 'start_archive.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-        tab0 = 50 
-        Lmodif = 1
-
-c     OR open start and startfi files
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      else
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start.nc and ./startfi.nc'
-        write(*,*)
-        fichnom = 'start.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
- 
-        fichnom = 'startfi.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-
-        tab0 = 0 
-        Lmodif = 0
-
-      endif
-
-
-c=======================================================================
-c  INITIALISATIONS DIVERSES
-c=======================================================================
-
-! Initialize global tracer indexes (stored in tracer.h)
-! ... this has to be done before phyetat0
-      call initracer(ngridmx,nqtot,tname)
-
-! Take care of arrays in common modules
-      ! ALLOCATE ARRAYS in surfdat_h (if not already done, e.g. when using start_archive)
-      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngridmx))
-      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngridmx))
-      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngridmx))
-      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngridmx))
-      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngridmx))
-      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngridmx))
-      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngridmx))
-      ! ALLOCATE ARRAYS in comsoil_h (if not already done)
-      IF (.not.ALLOCATED(layer))
-     . ALLOCATE(layer(nsoilmx))
-      IF (.not.ALLOCATED(mlayer))
-     . ALLOCATE(mlayer(0:nsoilmx-1))
-      IF (.not.ALLOCATED(inertiedat))
-     . ALLOCATE(inertiedat(ngridmx,nsoilmx))
-      ! ALLOCATE ARRAYS IN comgeomfi_h (done in inifis usually)
-      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
-      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
-      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
-
-c-----------------------------------------------------------------------
-c Lecture du tableau des parametres du run (pour la dynamique)
-c-----------------------------------------------------------------------
-      if (choix_1.eq.0) then
-
-        write(*,*) 'reading 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
-      else if (choix_1.eq.1) then
-
-        write(*,*) 'reading tab_cntrl START'
-c
-        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
-#else
-        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
-#endif
-c
-        write(*,*) 'reading tab_cntrl STARTFI'
-c
-        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
-#else
-        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
-#endif
-c
-        do i=1,50
-          tab_cntrl(i+50)=tab_cntrl_bis(i)
-        enddo
-        write(*,*) 'printing tab_cntrl', tab_cntrl
-        do i=1,100
-          write(*,*) i,tab_cntrl(i)
-        enddo
-	
-        ! Lmodif set to 0 to disable modifications possibility in phyeta0                           
-        write(*,*) 'Reading file START'
-        fichnom = 'start.nc'
-        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,time)
-
-        write(*,*) 'Reading file STARTFI'
-        fichnom = 'startfi.nc'
-        CALL phyetat0 (ngridmx,llm,fichnom,tab0,Lmodif,nsoilmx,
-     .        nqtot,day_ini,time,
-     .        tsurf,tsoil,emis,q2,qsurf,   !) ! temporary modif by RDW
-     .        cloudfrac,totalfrac,hice,rnat,pctsrf_sic,tslab,tsea_ice,
-     .        sea_ice)
-
-        ! copy albedo and soil thermal inertia on (local) physics grid
-        do i=1,ngridmx
-          albfi(i) = albedodat(i)
-	  do j=1,nsoilmx
-           ithfi(i,j) = inertiedat(i,j)
-	  enddo
-        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
-        ! be needed later on if reinitializing soil thermal inertia
-          surfithfi(i)=ithfi(i,1)
-        enddo
-        ! also copy albedo and soil thermal inertia on (local) dynamics grid
-        ! so that options below can manipulate either (but must then ensure
-        ! to correctly recast things on physics grid)
-        call gr_fi_dyn(1,ngridmx,iip1,jjp1,albfi,alb)
-        call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-        call gr_fi_dyn(1,ngridmx,iip1,jjp1,surfithfi,surfith)
-      
-      endif
-c-----------------------------------------------------------------------
-c		Initialisation des constantes dynamique
-c-----------------------------------------------------------------------
-
-      kappa = tab_cntrl(9) 
-      etot0 = tab_cntrl(12)
-      ptot0 = tab_cntrl(13)
-      ztot0 = tab_cntrl(14)
-      stot0 = tab_cntrl(15)
-      ang0 = tab_cntrl(16)
-      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
-      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
-
-      ! for vertical coordinate
-      preff=tab_cntrl(18) ! reference surface pressure
-      pa=tab_cntrl(17)  ! reference pressure at which coord is purely pressure
-      !NB: in start_archive files tab_cntrl(17)=tab_cntrl(18)=0
-      write(*,*) "Newstart: preff=",preff," pa=",pa
-      yes=' '
-      do while ((yes.ne.'y').and.(yes.ne.'n'))
-        write(*,*) "Change the values of preff and pa? (y/n)"
-        read(*,fmt='(a)') yes
-      end do
-      if (yes.eq.'y') then
-        write(*,*)"New value of reference surface pressure preff?"
-        write(*,*)"   (for Mars, typically preff=610)"
-        read(*,*) preff
-        write(*,*)"New value of reference pressure pa for purely"
-        write(*,*)"pressure levels (for hybrid coordinates)?"
-        write(*,*)"   (for Mars, typically pa=20)"
-        read(*,*) pa
-      endif
-c-----------------------------------------------------------------------
-c   Lecture du tab_cntrl et initialisation des constantes physiques
-c  - pour start:  Lmodif = 0 => pas de modifications possibles
-c                  (modif dans le tabfi de readfi + loin)
-c  - pour start_archive:  Lmodif = 1 => modifications possibles
-c-----------------------------------------------------------------------
-      if (choix_1.eq.0) then
-         ! tabfi requires that input file be first opened by open_startphy(fichnom)
-         fichnom = 'start_archive.nc'
-         call open_startphy(fichnom)
-         call tabfi (ngridmx,nid,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
-      else if (choix_1.eq.1) then
-         fichnom = 'startfi.nc'
-         call open_startphy(fichnom)
-         Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
-         call tabfi (ngridmx,nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_cpp,p_mugaz,p_daysec,time)
-      endif
-
-      if (p_omeg .eq. -9999.) then
-        p_omeg = 8.*atan(1.)/p_daysec
-        print*,"new value of omega",p_omeg
-      endif
-
-      rad = p_rad
-      omeg = p_omeg
-      g = p_g
-      cpp = p_cpp
-      mugaz = p_mugaz
-      daysec = p_daysec
-
-      if (p_omeg .eq. -9999.) then
-        p_omeg = 8.*atan(1.)/p_daysec
-        print*,"new value of omega",p_omeg
-      endif
-
-      kappa = 8.314*1000./(p_mugaz*p_cpp) ! added by RDW
-
-c=======================================================================
-c  INITIALISATIONS DIVERSES
-c=======================================================================
-! Load parameters from run.def file
-      CALL defrun_new( 99, .TRUE. )
-      CALL iniconst 
-      CALL inigeom
-      idum=-1
-      idum=0
-
-c Initialisation coordonnees /aires
-c -------------------------------
-! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
-!       rlatu() and rlonv() are given in radians
-      latfi(1)=rlatu(1)
-      lonfi(1)=0.
-      DO j=2,jjm
-         DO i=1,iim
-            latfi((j-2)*iim+1+i)=rlatu(j)
-            lonfi((j-2)*iim+1+i)=rlonv(i)
-         ENDDO
-      ENDDO
-      latfi(ngridmx)=rlatu(jjp1)
-      lonfi(ngridmx)=0.
-       
-      ! build airefi(), mesh area on physics grid
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-      ! Poles are single points on physics grid
-      airefi(1)=sum(aire(1:iim,1))
-      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
-
-! also initialize various physics flags/settings which might be needed
-!    (for instance initracer needs to know about some flags, and/or
-!      'datafile' path may be changed by user)
-      call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
-     &                latfi,lonfi,airefi,rad,g,r,cpp)
-
-c=======================================================================
-c   lecture topographie, albedo, inertie thermique, relief sous-maille
-c=======================================================================
-
-      if (choix_1.eq.0) then  ! for start_archive files, 
-                              ! where an external "surface.nc" file is needed
-
-c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
-c       write(*,*)
-c       write(*,*) 'choix du relief (mola,pla)'
-c       write(*,*) '(Topographie MGS MOLA, plat)'
-c       read(*,fmt='(a3)') relief
-        relief="mola"
-c     enddo
-
-!    First get the correct value of datadir, if not already done:
-        ! default 'datadir' is set in "datafile_mod"
-        call getin_p("datadir",datadir)
-        write(*,*) 'Available surface data files are:'
-        filestring='ls '//trim(datadir)//' | grep .nc'
-        call system(filestring)
-
-        write(*,*) ''
-        write(*,*) 'Please choose the relevant file',
-     &  ' (e.g. "surface_mars.nc")'
-        write(*,*) ' or "none" to not use any (and set planetary'
-        write(*,*) '  albedo and surface thermal inertia)'
-        read(*,fmt='(a50)') surfacefile
-
-        if (surfacefile.ne."none") then
-
-          CALL datareadnc(relief,surfacefile,phis,alb,surfith,
-     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
-        else
-        ! specific case when not using a "surface.nc" file
-          phis(:,:)=0
-          zmeaS(:,:)=0
-          zstdS(:,:)=0
-          zsigS(:,:)=0
-          zgamS(:,:)=0
-          ztheS(:,:)=0
-          
-          write(*,*) "Enter value of albedo of the bare ground:"
-          read(*,*) alb(1,1)
-          alb(:,:)=alb(1,1)
-          
-          write(*,*) "Enter value of thermal inertia of soil:"
-          read(*,*) surfith(1,1)
-          surfith(:,:)=surfith(1,1)
-        
-        endif ! of if (surfacefile.ne."none")
-
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
-        CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
-
-      endif ! of if (choix_1.eq.0)
-
-
-c=======================================================================
-c  Lecture des fichiers (start ou start_archive)
-c=======================================================================
-
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Reading file START_ARCHIVE'
-        CALL lect_start_archive(ngridmx,llm,
-     &   date,tsurf,tsoil,emis,q2,
-     &   t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf,
-     &   surfith,nid,
-     &   rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
-        write(*,*) "OK, read start_archive file"
-	! copy soil thermal inertia
-	ithfi(:,:)=inertiedat(:,:)
-	
-        ierr= NF_CLOSE(nid)
-
-      else if (choix_1.eq.1) then 
-         !do nothing, start and startfi have already been read
-      else 
-        CALL exit(1)
-      endif
-
-      dtvr   = daysec/FLOAT(day_step)
-      dtphys   = dtvr * FLOAT(iphysiq)
-
-c=======================================================================
-c 
-c=======================================================================
-
-      do ! infinite loop on list of changes
-
-      write(*,*)
-      write(*,*)
-      write(*,*) 'List of possible changes :'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      write(*,*)
-      write(*,*) 'flat : no topography ("aquaplanet")'
-      write(*,*) 'set_ps_to_preff : used if changing preff with topo'
-      write(*,*) 'nuketharsis : no Tharsis bulge'
-      write(*,*) 'bilball : uniform albedo and thermal inertia'
-      write(*,*) 'coldspole : cold subsurface and high albedo at S.pole'
-      write(*,*) 'qname : change tracer name'
-      write(*,*) 't=profile  : read temperature profile in profile.in'
-      write(*,*) 'q=0 : ALL tracer =zero'
-      write(*,*) 'q=x : give a specific uniform value to one tracer'
-      write(*,*) 'q=profile    : specify a profile for a tracer'
-!      write(*,*) 'ini_q : tracers initialisation for chemistry, water an
-!     $d ice   '
-!      write(*,*) 'ini_q-H2O : tracers initialisation for chemistry and 
-!     $ice '
-!      write(*,*) 'ini_q-iceH2O : tracers initialisation for chemistry on
-!     $ly '
-      write(*,*) 'noglacier : Remove tropical H2O ice if |lat|<45'
-      write(*,*) 'watercapn : H20 ice on permanent N polar cap '
-      write(*,*) 'watercaps : H20 ice on permanent S polar cap '
-      write(*,*) 'noacglac  : H2O ice across Noachis Terra'
-      write(*,*) 'oborealis : H2O ice across Vastitas Borealis'
-      write(*,*) 'iceball   : Thick ice layer all over surface'
-      write(*,*) 'supercontinent: Create a continent of given Ab and TI'
-      write(*,*) 'wetstart  : start with a wet atmosphere'
-      write(*,*) 'isotherm  : Isothermal Temperatures, wind set to zero'
-      write(*,*) 'radequi   : Earth-like radiative equilibrium temperature
-     $ profile (lat-alt) and winds set to zero'
-      write(*,*) 'coldstart : Start X K above the CO2 frost point and 
-     $set wind to zero (assumes 100% CO2)'
-      write(*,*) 'co2ice=0 : remove CO2 polar cap'
-      write(*,*) 'ptot : change total pressure'
-      write(*,*) 'emis : change surface emissivity'
-      write(*,*) 'therm_ini_s : Set soil thermal inertia to reference sur
-     &face values'
-      write(*,*) 'slab_ocean_0 : initialisation of slab 
-     $ocean variables'
-
-        write(*,*)
-        write(*,*) 'Change to perform ?'
-        write(*,*) '   (enter keyword or return to end)'
-        write(*,*)
-
-        read(*,fmt='(a20)') modif
-        if (modif(1:1) .eq. ' ')then
-         exit ! exit loop on changes
-        endif
-
-        write(*,*)
-        write(*,*) trim(modif) , ' : '
-
-c       'flat : no topography ("aquaplanet")'
-c       -------------------------------------
-        if (trim(modif) .eq. 'flat') then
-c         set topo to zero 
-          z_reel(1:iip1,1:jjp1)=0
-          phis(1:iip1,1:jjp1)=g*z_reel(1:iip1,1:jjp1)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-          write(*,*) 'topography set to zero.'
-          write(*,*) 'WARNING : the subgrid topography parameters',
-     &    ' were not set to zero ! => set calllott to F'                    
-
-c        Choice of surface pressure
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to choose homogeneous surface',
-     &                 'pressure (y) or let newstart interpolate ',
-     &                 ' the previous field  (n)?'
-             read(*,fmt='(a)') yes
-         end do
-         if (yes.eq.'y') then
-           flagps0=.true.
-           write(*,*) 'New value for ps (Pa) ?'
- 201       read(*,*,iostat=ierr) patm
-            if(ierr.ne.0) goto 201
-            write(*,*) patm
-            if (patm.eq.-9999.) then
-              patm = preff
-              write(*,*) "we set patm = preff", preff
-            endif
-             write(*,*)
-             write(*,*) ' new ps everywhere (Pa) = ', patm
-             write(*,*)
-             do j=1,jjp1
-               do i=1,iip1
-                 ps(i,j)=patm
-               enddo
-             enddo
-         end if
-
-c       'set_ps_to_preff' : used if changing preff with topo  
-c       ----------------------------------------------------
-        else if (trim(modif) .eq. 'set_ps_to_preff') then
-          do j=1,jjp1
-           do i=1,iip1
-             ps(i,j)=preff
-           enddo
-          enddo
-
-c       'nuketharsis : no tharsis bulge for Early Mars'
-c       ---------------------------------------------
-        else if (trim(modif) .eq. 'nuketharsis') then
-
-           DO j=1,jjp1        
-              DO i=1,iim
-                 ig=1+(j-2)*iim +i
-                 if(j.eq.1) ig=1
-                 if(j.eq.jjp1) ig=ngridmx
-
-                 fact1=(((rlonv(i)*180./pi)+100)**2 + 
-     &                (rlatu(j)*180./pi)**2)/65**2 
-                 fact2=exp( -fact1**2.5 )
-
-                 phis(i,j) = phis(i,j) - (phis(i,j)+4000.*g)*fact2
-
-!                 if(phis(i,j).gt.2500.*g)then
-!                    if(rlatu(j)*180./pi.gt.-80.)then ! avoid chopping south polar cap
-!                       phis(i,j)=2500.*g
-!                    endif
-!                 endif
-
-              ENDDO
-           ENDDO
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-
-
-c       bilball : uniform albedo, thermal inertia
-c       -----------------------------------------
-        else if (trim(modif) .eq. 'bilball') then
-          write(*,*) 'constante albedo and iner.therm:'
-          write(*,*) 'New value for albedo (ex: 0.25) ?'
- 101      read(*,*,iostat=ierr) alb_bb
-          if(ierr.ne.0) goto 101
-          write(*,*)
-          write(*,*) ' uniform albedo (new value):',alb_bb
-          write(*,*)
-
-          write(*,*) 'New value for thermal inertia (eg: 247) ?'
- 102      read(*,*,iostat=ierr) ith_bb
-          if(ierr.ne.0) goto 102
-          write(*,*) 'uniform thermal inertia (new value):',ith_bb
-          DO j=1,jjp1
-             DO i=1,iip1
-                alb(i,j) = alb_bb	! albedo
-		do isoil=1,nsoilmx
-                  ith(i,j,isoil) = ith_bb	! thermal inertia
-		enddo
-             END DO
-          END DO
-!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-c       coldspole : sous-sol de la calotte sud toujours froid
-c       -----------------------------------------------------
-        else if (trim(modif) .eq. 'coldspole') then
-          write(*,*)'new value for the subsurface temperature',
-     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
- 103      read(*,*,iostat=ierr) tsud
-          if(ierr.ne.0) goto 103
-          write(*,*)
-          write(*,*) ' new value of the subsurface temperature:',tsud
-c         nouvelle temperature sous la calotte permanente
-          do l=2,nsoilmx
-               tsoil(ngridmx,l) =  tsud
-          end do
-
-
-          write(*,*)'new value for the albedo',
-     &   'of the permanent southern polar cap ? (eg: 0.75)'
- 104      read(*,*,iostat=ierr) albsud
-          if(ierr.ne.0) goto 104
-          write(*,*)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c         Option 1:  only the albedo of the pole is modified :    
-          albfi(ngridmx)=albsud
-          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
-     &    albfi(ngridmx)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
-c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
-c           DO j=1,jjp1
-c             DO i=1,iip1
-c                ig=1+(j-2)*iim +i
-c                if(j.eq.1) ig=1
-c                if(j.eq.jjp1) ig=ngridmx
-c                if ((rlatu(j)*180./pi.lt.-84.).and.
-c     &            (rlatu(j)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.lt.0.))         then
-cc    albedo de la calotte permanente fixe a albsud
-c                   alb(i,j)=albsud
-c                   write(*,*) 'lat=',rlatu(j)*180./pi,
-c     &                      ' lon=',rlonv(i)*180./pi
-cc     fin de la condition sur les limites de la calotte permanente
-c                end if
-c             ENDDO
-c          ENDDO
-c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-
-c       ptot : Modification of the total pressure: ice + current atmosphere 
-c       -------------------------------------------------------------------
-        else if (trim(modif).eq.'ptot') then
-
-          ! check if we have a co2_ice surface tracer:
-          if (igcm_co2_ice.eq.0) then
-            write(*,*) " No surface CO2 ice !"
-            write(*,*) " only atmospheric pressure will be considered!"
-          endif
-c         calcul de la pression totale glace + atm actuelle
-          patm=0.
-          airetot=0.
-          pcap=0.
-          DO j=1,jjp1
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-                patm = patm + ps(i,j)*aire(i,j)
-                airetot= airetot + aire(i,j)
-                if (igcm_co2_ice.ne.0) then
-                  !pcap = pcap + aire(i,j)*co2ice(ig)*g
-                  pcap = pcap + aire(i,j)*qsurf(ig,igcm_co2_ice)*g
-                endif
-             ENDDO
-          ENDDO
-          ptoto = pcap + patm
-
-          print*,'Current total pressure at surface (co2 ice + atm) ',
-     &       ptoto/airetot
-
-          print*,'new value?'
-          read(*,*) ptotn
-          ptotn=ptotn*airetot
-          patmn=ptotn-pcap
-          print*,'ptoto,patm,ptotn,patmn'
-          print*,ptoto,patm,ptotn,patmn
-          print*,'Mult. factor for pressure (atm only)', patmn/patm
-          do j=1,jjp1
-             do i=1,iip1
-                ps(i,j)=ps(i,j)*patmn/patm
-             enddo
-          enddo
-
-
-
-c        Correction pour la conservation des traceurs
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to conserve tracer total mass (y)',
-     &              ' or tracer mixing ratio (n) ?'
-             read(*,fmt='(a)') yes
-         end do
-
-         if (yes.eq.'y') then
-           write(*,*) 'OK : conservation of tracer total mass'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-          else
-            write(*,*) 'OK : conservation of tracer mixing ratio'
-          end if
-
-c        Correction pour la pression au niveau de la mer
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish fix pressure at sea level (y)',
-     &              ' or not (n) ?'
-             read(*,fmt='(a)') yes
-         end do
-
-         if (yes.eq.'y') then
-           write(*,*) 'Value?'
-		read(*,*,iostat=ierr) psea
-             DO i=1,iip1
-               DO j=1,jjp1
-                    ps(i,j)=psea
-
-                  ENDDO
-               ENDDO
-		write(*,*) 'psea=',psea
-          else
-            write(*,*) 'no'
-          end if
-
-
-c       emis : change surface emissivity (added by RW)
-c       ----------------------------------------------
-        else if (trim(modif).eq.'emis') then
-
-           print*,'new value?'
-           read(*,*) emisread
-
-           do i=1,ngridmx
-              emis(i)=emisread
-           enddo
-
-c       qname : change tracer name
-c       --------------------------
-        else if (trim(modif).eq.'qname') then
-         yes='y'
-         do while (yes.eq.'y')
-          write(*,*) 'Which tracer name do you want to change ?'
-          do iq=1,nqtot
-            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
-          enddo
-          write(*,'(a35,i3)')
-     &            '(enter tracer number; between 1 and ',nqtot
-          write(*,*)' or any other value to quit this option)'
-          read(*,*) iq
-          if ((iq.ge.1).and.(iq.le.nqtot)) then
-            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
-            read(*,*) txt
-            tname(iq)=txt
-            write(*,*)'Do you want to change another tracer name (y/n)?'
-            read(*,'(a)') yes 
-          else
-! inapropiate value of iq; quit this option
-            yes='n'
-          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
-         enddo ! of do while (yes.ne.'y')
-
-c       q=0 : set tracers to zero
-c       -------------------------
-        else if (trim(modif).eq.'q=0') then
-c          mise a 0 des q (traceurs)
-          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=1.e-30
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-
-c          set surface tracers to zero
-           DO iq =1, nqtot
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=0.
-             ENDDO
-           ENDDO
-
-c       q=x : initialise tracer manually 
-c       --------------------------------
-        else if (trim(modif).eq.'q=x') then
-             write(*,*) 'Which tracer do you want to modify ?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
-     &                 ' ? (kg/kg)'
-             read(*,*) val
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=val
-                  ENDDO
-               ENDDO
-             ENDDO
-             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
-     &                   ' ? (kg/m2)'
-             read(*,*) val
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=val
-             ENDDO
-
-c       t=profile : initialize temperature with a given profile
-c       -------------------------------------------------------
-        else if (trim(modif) .eq. 't=profile') then
-             write(*,*) 'Temperature profile from ASCII file'
-             write(*,*) "'profile.in' e.g. 1D output"
-             write(*,*) "(one value per line in file; starting with"
-             write(*,*) "surface value, the 1st atmospheric layer"
-             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
-             txt="profile.in"
-             open(33,file=trim(txt),status='old',form='formatted',
-     &            iostat=ierr)
-             if (ierr.eq.0) then
-               ! OK, found file 'profile_...', load the profile
-               do l=1,llm+1
-                 read(33,*,iostat=ierr) profile(l)
-                 write(*,*) profile(l)
-                 if (ierr.ne.0) then ! something went wrong
-                   exit ! quit loop
-                 endif
-               enddo
-               if (ierr.eq.0) then
-                 tsurf(1:ngridmx)=profile(1)
-                 tsoil(1:ngridmx,1:nsoilmx)=profile(1)
-                 do l=1,llm
-                   Tset(1:iip1,1:jjp1,l)=profile(l+1)
-                   flagtset=.true.
-                 enddo
-                 ucov(1:iip1,1:jjp1,1:llm)=0.
-                 vcov(1:iip1,1:jjm,1:llm)=0.
-                 q2(1:ngridmx,1:llm+1)=0.
-               else
-                 write(*,*)'problem reading file ',trim(txt),' !'
-                 write(*,*)'No modifications to temperature'
-               endif
-             else
-               write(*,*)'Could not find file ',trim(txt),' !'
-               write(*,*)'No modifications to temperature'
-             endif
-
-c       q=profile : initialize tracer with a given profile
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'q=profile') then
-             write(*,*) 'Tracer profile will be sought in ASCII file'
-             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
-             write(*,*) "(one value per line in file; starting with"
-             write(*,*) "surface value, the 1st atmospheric layer"
-             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
-             write(*,*) 'Which tracer do you want to set?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             if ((iq.lt.1).or.(iq.gt.nqtot)) then
-               ! wrong value for iq, go back to menu
-               write(*,*) "wrong input value:",iq
-               cycle
-             endif
-             ! look for input file 'profile_tracer'
-             txt="profile_"//trim(tname(iq))
-             open(41,file=trim(txt),status='old',form='formatted',
-     &            iostat=ierr)
-             if (ierr.eq.0) then
-               ! OK, found file 'profile_...', load the profile
-               do l=1,llm+1
-                 read(41,*,iostat=ierr) profile(l)
-                 if (ierr.ne.0) then ! something went wrong
-                   exit ! quit loop
-                 endif
-               enddo
-               if (ierr.eq.0) then
-                 ! initialize tracer values
-                 qsurf(:,iq)=profile(1)
-                 do l=1,llm
-                   q(:,:,l,iq)=profile(l+1)
-                 enddo
-                 write(*,*)'OK, tracer ',trim(tname(iq)),' initialized '
-     &                    ,'using values from file ',trim(txt)
-               else
-                 write(*,*)'problem reading file ',trim(txt),' !'
-                 write(*,*)'No modifications to tracer ',trim(tname(iq))
-               endif
-             else
-               write(*,*)'Could not find file ',trim(txt),' !'
-               write(*,*)'No modifications to tracer ',trim(tname(iq))
-             endif
-             
-
-c      wetstart : wet atmosphere with a north to south gradient
-c      --------------------------------------------------------
-       else if (trim(modif) .eq. 'wetstart') then
-        ! check that there is indeed a water vapor tracer
-        if (igcm_h2o_vap.eq.0) then
-          write(*,*) "No water vapour tracer! Can't use this option"
-          stop
-        endif
-          DO l=1,llm
-            DO j=1,jjp1
-              DO i=1,iip1
-                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
-              ENDDO
-            ENDDO
-          ENDDO
-
-         write(*,*) 'Water mass mixing ratio at north pole='
-     *               ,q(1,1,1,igcm_h2o_vap)
-         write(*,*) '---------------------------south pole='
-     *               ,q(1,jjp1,1,igcm_h2o_vap)
-
-c      noglacier : remove tropical water ice (to initialize high res sim)
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'noglacier') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-           do ig=1,ngridmx
-             j=(ig-2)/iim +2
-              if(ig.eq.1) j=1
-              write(*,*) 'OK: remove surface ice for |lat|<45'
-              if (abs(rlatu(j)*180./pi).lt.45.) then
-                   qsurf(ig,igcm_h2o_ice)=0.
-              end if
-           end do
-
-
-c      watercapn : H20 ice on permanent northern cap
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'watercapn') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-
-           DO j=1,jjp1        
-              DO i=1,iim
-                 ig=1+(j-2)*iim +i
-                 if(j.eq.1) ig=1
-                 if(j.eq.jjp1) ig=ngridmx
-
-                 if (rlatu(j)*180./pi.gt.80.) then
-                    qsurf(ig,igcm_h2o_ice)=3.4e3
-                    !do isoil=1,nsoilmx
-                    !   ith(i,j,isoil) = 18000. ! thermal inertia
-                    !enddo
-                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
-     &                   rlatv(j-1)*180./pi
-                 end if
-              ENDDO
-           ENDDO
-           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-c$$$           do ig=1,ngridmx
-c$$$             j=(ig-2)/iim +2
-c$$$              if(ig.eq.1) j=1
-c$$$              if (rlatu(j)*180./pi.gt.80.) then
-c$$$
-c$$$                   qsurf(ig,igcm_h2o_ice)=1.e5
-c$$$                   qsurf(ig,igcm_h2o_vap)=0.0!1.e5
-c$$$
-c$$$                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
-c$$$     &              qsurf(ig,igcm_h2o_ice)
-c$$$
-c$$$                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
-c$$$     &              rlatv(j)*180./pi
-c$$$                end if
-c$$$           enddo
-
-c      watercaps : H20 ice on permanent southern cap
-c      -------------------------------------------------
-        else if (trim(modif) .eq. 'watercaps') then
-           if (igcm_h2o_ice.eq.0) then
-              write(*,*) "No water ice tracer! Can't use this option"
-              stop
-           endif
-
-           DO j=1,jjp1        
-              DO i=1,iim
-                 ig=1+(j-2)*iim +i
-                 if(j.eq.1) ig=1
-                 if(j.eq.jjp1) ig=ngridmx
-
-                 if (rlatu(j)*180./pi.lt.-80.) then
-                    qsurf(ig,igcm_h2o_ice)=3.4e3
-                    !do isoil=1,nsoilmx
-                    !   ith(i,j,isoil) = 18000. ! thermal inertia
-                    !enddo
-                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
-     &                   rlatv(j-1)*180./pi
-                 end if
-              ENDDO
-           ENDDO
-           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-c$$$           do ig=1,ngridmx
-c$$$               j=(ig-2)/iim +2
-c$$$               if(ig.eq.1) j=1
-c$$$               if (rlatu(j)*180./pi.lt.-80.) then
-c$$$                  qsurf(ig,igcm_h2o_ice)=1.e5
-c$$$                  qsurf(ig,igcm_h2o_vap)=0.0 !1.e5
-c$$$
-c$$$                  write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
-c$$$     &                 qsurf(ig,igcm_h2o_ice)
-c$$$                  write(*,*)'     ==> Ice mesh North boundary (deg)= ',
-c$$$     &                 rlatv(j-1)*180./pi
-c$$$               end if
-c$$$           enddo
-
-
-c       noacglac : H2O ice across highest terrain
-c       --------------------------------------------
-        else if (trim(modif) .eq. 'noacglac') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-          DO j=1,jjp1        
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-
-                if(phis(i,j).gt.1000.*g)then
-                    alb(i,j) = 0.5 ! snow value
-                    do isoil=1,nsoilmx
-                       ith(i,j,isoil) = 18000. ! thermal inertia
-                       ! this leads to rnat set to 'ocean' in physiq.F90
-                       ! actually no, because it is soil not surface
-                    enddo
-                endif
-             ENDDO
-          ENDDO
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-
-
-
-c       oborealis : H2O oceans across Vastitas Borealis
-c       -----------------------------------------------
-        else if (trim(modif) .eq. 'oborealis') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-          DO j=1,jjp1        
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-
-                if(phis(i,j).lt.-4000.*g)then
-!                if( (phis(i,j).lt.-4000.*g)
-!     &               .and. (rlatu(j)*180./pi.lt.0.) )then ! south hemisphere only
-!                    phis(i,j)=-8000.0*g ! proper ocean
-                    phis(i,j)=-4000.0*g ! scanty ocean
-
-                    alb(i,j) = 0.07 ! oceanic value
-                    do isoil=1,nsoilmx
-                       ith(i,j,isoil) = 18000. ! thermal inertia
-                       ! this leads to rnat set to 'ocean' in physiq.F90
-                       ! actually no, because it is soil not surface
-                    enddo
-                endif
-             ENDDO
-          ENDDO
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-
-c       iborealis : H2O ice in Northern plains
-c       --------------------------------------
-        else if (trim(modif) .eq. 'iborealis') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-          DO j=1,jjp1        
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-
-                if(phis(i,j).lt.-4000.*g)then
-                   !qsurf(ig,igcm_h2o_ice)=1.e3
-                   qsurf(ig,igcm_h2o_ice)=241.4 ! to make total 33 kg m^-2
-                endif
-             ENDDO
-          ENDDO
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-
-
-c       oceanball : H2O liquid everywhere
-c       ----------------------------
-        else if (trim(modif) .eq. 'oceanball') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-          DO j=1,jjp1        
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-
-                qsurf(ig,igcm_h2o_vap)=0.0    ! for ocean, this is infinite source
-                qsurf(ig,igcm_h2o_ice)=0.0
-                alb(i,j) = 0.07 ! ocean value
-
-                do isoil=1,nsoilmx
-                   ith(i,j,isoil) = 18000. ! thermal inertia
-                   !ith(i,j,isoil) = 50. ! extremely low for test
-                   ! this leads to rnat set to 'ocean' in physiq.F90
-                enddo
-
-             ENDDO
-          ENDDO
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-
-c       iceball : H2O ice everywhere
-c       ----------------------------
-        else if (trim(modif) .eq. 'iceball') then
-           if (igcm_h2o_ice.eq.0) then
-             write(*,*) "No water ice tracer! Can't use this option"
-             stop
-           endif
-          DO j=1,jjp1        
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-
-                qsurf(ig,igcm_h2o_vap)=-50.    ! for ocean, this is infinite source
-                qsurf(ig,igcm_h2o_ice)=50.     ! == to 0.05 m of oceanic ice
-                alb(i,j) = 0.6 ! ice albedo value
-
-                do isoil=1,nsoilmx
-                   !ith(i,j,isoil) = 18000. ! thermal inertia
-                   ! this leads to rnat set to 'ocean' in physiq.F90
-                enddo
-
-             ENDDO
-          ENDDO
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-c       supercontinent : H2O ice everywhere
-c       ----------------------------
-        else if (trim(modif) .eq. 'supercontinent') then
-          write(*,*) 'Minimum longitude (-180,180)'
-          read(*,*) val
-          write(*,*) 'Maximum longitude (-180,180)'
-          read(*,*) val2
-          write(*,*) 'Minimum latitude (-90,90)'
-          read(*,*) val3
-          write(*,*) 'Maximum latitude (-90,90)'
-          read(*,*) val4
-
-          do j=1,jjp1
-            do i=1,iip1
-              ig=1+(j-2)*iim +i
-              if(j.eq.1) ig=1
-              if(j.eq.jjp1) ig=ngridmx
-
-c             Supercontinent:
-              if (((rlatu(j)*180./pi.le.val4).and.
-     &            (rlatu(j)*180./pi.ge.val3).and.
-     &            (rlonv(i)*180./pi.le.val2).and.
-     &            (rlonv(i)*180./pi.ge.val))) then
-
-                rnat(ig)=1.
-                alb(i,j) = 0.3
-                do isoil=1,nsoilmx
-                  ith(i,j,isoil) = 2000.
-                enddo
-c             Ocean:
-              else
-                rnat(ig)=0.
-                alb(i,j) = 0.07
-                do isoil=1,nsoilmx
-                  ith(i,j,isoil) = 18000.
-                enddo
-              end if
-
-            enddo
-          enddo
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-c       isotherm : Isothermal temperatures and no winds
-c       -----------------------------------------------
-        else if (trim(modif) .eq. 'isotherm') then
-
-          write(*,*)'Isothermal temperature of the atmosphere, 
-     &           surface and subsurface'
-          write(*,*) 'Value of this temperature ? :'
- 203      read(*,*,iostat=ierr) Tiso
-          if(ierr.ne.0) goto 203
-
-          tsurf(1:ngridmx)=Tiso
-          
-          tsoil(1:ngridmx,1:nsoilmx)=Tiso
-          
-          Tset(1:iip1,1:jjp1,1:llm)=Tiso
-          flagtset=.true.
-
-          t(1:iip1,1:jjp1,1:llm)=Tiso
-          !! otherwise hydrost. integrations below
-          !! use the wrong temperature
-          !! -- NB: Tset might be useless
-        
-          ucov(1:iip1,1:jjp1,1:llm)=0
-          vcov(1:iip1,1:jjm,1:llm)=0
-          q2(1:ngridmx,1:llm+1)=0
-
-c       radequi : Radiative equilibrium profile of temperatures and no winds
-c       --------------------------------------------------------------------
-        else if (trim(modif) .eq. 'radequi') then
-
-          write(*,*)'radiative equilibrium temperature profile'       
-
-          do ig=1, ngridmx
-             teque= 335.0-60.0*sin(latfi(ig))*sin(latfi(ig))-
-     &            10.0*cos(latfi(ig))*cos(latfi(ig))
-             tsurf(ig) = MAX(220.0,teque)
-          end do
-          do l=2,nsoilmx
-             do ig=1, ngridmx
-                tsoil(ig,l) = tsurf(ig)
-             end do
-          end do
-          DO j=1,jjp1
-             DO i=1,iim
-                Do l=1,llm
-                   teque=335.-60.0*sin(rlatu(j))*sin(rlatu(j))-
-     &                  10.0*cos(rlatu(j))*cos(rlatu(j))
-                   Tset(i,j,l)=MAX(220.0,teque)
-                end do
-             end do
-          end do
-          flagtset=.true.
-          ucov(1:iip1,1:jjp1,1:llm)=0
-          vcov(1:iip1,1:jjm,1:llm)=0
-          q2(1:ngridmx,1:llm+1)=0
-
-c       coldstart : T set 1K above CO2 frost point and no winds
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'coldstart') then
-
-          write(*,*)'set temperature of the atmosphere,' 
-     &,'surface and subsurface how many degrees above CO2 frost point?'
- 204      read(*,*,iostat=ierr) Tabove
-          if(ierr.ne.0) goto 204
-
-            DO j=1,jjp1
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-            tsurf(ig) = (-3167.8)/(log(.01*ps(i,j))-23.23)+Tabove
-             END DO
-            END DO
-          do l=1,nsoilmx
-            do ig=1, ngridmx
-              tsoil(ig,l) = tsurf(ig)
-            end do
-          end do
-          DO j=1,jjp1
-           DO i=1,iim
-            Do l=1,llm
-               pp = aps(l) +bps(l)*ps(i,j) 
-               Tset(i,j,l)=(-3167.8)/(log(.01*pp)-23.23)+Tabove
-            end do
-           end do
-          end do
-
-          flagtset=.true.
-          ucov(1:iip1,1:jjp1,1:llm)=0
-          vcov(1:iip1,1:jjm,1:llm)=0
-          q2(1:ngridmx,1:llm+1)=0
-
-
-c       co2ice=0 : remove CO2 polar ice caps'
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'co2ice=0') then
-         ! check that there is indeed a co2_ice tracer ...
-          if (igcm_co2_ice.ne.0) then
-           do ig=1,ngridmx
-              !co2ice(ig)=0
-              qsurf(ig,igcm_co2_ice)=0
-              emis(ig)=emis(ngridmx/2)
-           end do
-          else
-            write(*,*) "Can't remove CO2 ice!! (no co2_ice tracer)"
-          endif
-        
-!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
-!       ----------------------------------------------------------------------
-
-	else if (trim(modif) .eq. 'therm_ini_s') then
-!          write(*,*)"surfithfi(1):",surfithfi(1)
-	  do isoil=1,nsoilmx
-	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
-	  enddo
-          write(*,*)'OK: Soil thermal inertia has been reset to referenc
-     &e surface values'
-!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
-	  ithfi(:,:)=inertiedat(:,:)
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-! Check:
-!         do i=1,iip1
-!           do j=1,jjp1
-!             do isoil=1,nsoilmx
-!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
-!             enddo
-!           enddo
-!	 enddo
-
-
-
-c       slab_ocean_initialisation
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'slab_ocean_0') then
-        write(*,*)'OK: initialisation of slab ocean' 
-
-      DO ig=1, ngridmx
-         rnat(ig)=1.
-         tslab(ig,1)=0.
-         tslab(ig,2)=0.
-         tsea_ice(ig)=0.
-         sea_ice(ig)=0.
-         pctsrf_sic(ig)=0.
-         
-         if(ithfi(ig,1).GT.10000.)then
-           rnat(ig)=0.
-           phisfi(ig)=0.
-           tsea_ice(ig)=273.15-1.8
-           tslab(ig,1)=tsurf(ig)
-           tslab(ig,2)=tsurf(ig)!*2./3.+(273.15-1.8)/3.
-          endif
-
-      ENDDO
-          CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,phisfi,phis)
-
-
-
-        else
-          write(*,*) '       Unknown (misspelled?) option!!!'
-        end if ! of if (trim(modif) .eq. '...') elseif ...
-
-
-
-       enddo ! of do ! infinite loop on liste of changes
-
- 999  continue
-
- 
-c=======================================================================
-c   Initialisation for cloud fraction and oceanic ice (added by BC 2010)
-c=======================================================================
-      DO ig=1, ngridmx
-         totalfrac(ig)=0.5
-         DO l=1,llm
-            cloudfrac(ig,l)=0.5
-         ENDDO
-! Ehouarn, march 2012: also add some initialisation for hice
-         hice(ig)=0.0
-      ENDDO
-      
-c========================================================
-
-!      DO ig=1,ngridmx
-!         IF(tsurf(ig) .LT. 273.16-1.8) THEN
-!            hice(ig)=(273.16-1.8-tsurf(ig))/(273.16-1.8-240)*1.
-!            hice(ig)=min(hice(ig),1.0)
-!         ENDIF
-!      ENDDO
-
-
-
-
-c=======================================================================
-c   Correct pressure on the new grid (menu 0)
-c=======================================================================
-
-
-      if ((choix_1.eq.0).and.(.not.flagps0)) then
-        r = 1000.*8.31/mugaz
-
-        do j=1,jjp1
-          do i=1,iip1
-             ps(i,j) = ps(i,j) *
-     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
-     .                                  (t(i,j,1) * r))
-          end do
-        end do
-
-c periodicite de ps en longitude
-        do j=1,jjp1
-          ps(1,j) = ps(iip1,j)
-        end do
-      end if
-
-         
-c=======================================================================
-c=======================================================================
-
-c=======================================================================
-c    Initialisation de la physique / ecriture de newstartfi :
-c=======================================================================
-
-
-      CALL inifilr 
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-
-c-----------------------------------------------------------------------
-c   Initialisation  pks:
-c-----------------------------------------------------------------------
-
-      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-! Calcul de la temperature potentielle teta
-
-      if (flagtset) then
-          DO l=1,llm
-             DO j=1,jjp1
-                DO i=1,iim
-                   teta(i,j,l) = Tset(i,j,l) * cpp/pk(i,j,l)
-                ENDDO
-                teta (iip1,j,l)= teta (1,j,l)
-             ENDDO
-          ENDDO
-      else if (choix_1.eq.0) then
-         DO l=1,llm
-            DO j=1,jjp1
-               DO i=1,iim
-                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
-               ENDDO
-               teta (iip1,j,l)= teta (1,j,l)
-            ENDDO
-         ENDDO
-      endif
-
-C Calcul intermediaire
-c
-      if (choix_1.eq.0) then
-         CALL massdair( p3d, masse  )
-c
-         print *,' ALPHAX ',alphax
-
-         DO  l = 1, llm
-           DO  i    = 1, iim
-             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
-             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
-           ENDDO
-             xpn      = SUM(xppn)/apoln
-             xps      = SUM(xpps)/apols
-           DO i   = 1, iip1
-             masse(   i   ,   1     ,  l )   = xpn
-             masse(   i   ,   jjp1  ,  l )   = xps
-           ENDDO
-         ENDDO
-      endif
-      phis(iip1,:) = phis(1,:)
-
-      itau=0
-      if (choix_1.eq.0) then
-         day_ini=int(date)
-      endif
-c
-      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
-
-      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
-     *                phi,w, pbaru,pbarv,day_ini+time )
-
-          
-      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
-      CALL dynredem1("restart.nc",0.0,vcov,ucov,teta,q,nqtot,masse,ps) 
-C
-C Ecriture etat initial physique
-C
-
-      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
-     &              nqtot,dtphys,real(day_ini),0.0,
-     &              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nq,
-     &                dtphys,real(day_ini),
-     &                tsurf,tsoil,emis,q2,qsurf,
-     &                cloudfrac,totalfrac,hice,
-     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
-
-c=======================================================================
-c	Formats 
-c=======================================================================
-
-   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur parametree llm =',i4//)
-
-      write(*,*) "newstart: All is well that ends well."
-
-      end
-
Index: unk/LMDZ.GENERIC/libf/phystd/phasechange_kcm.F90
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/phasechange_kcm.F90	(revision 1402)
+++ 	(revision )
@@ -1,1286 +1,0 @@
-!  ----------------------------------------------------------------
-!  Purpose: Thermodynamic data on H2O, NH3
-!  Authour: Adapted from various sources by R. Wordsworth (2011)
-
-
-! ---------------------
-! NH3
-! ---------------------
-subroutine psat_NH3 ( T, p )
-!
-!  PSAT_NH3 makes a rough estimate of the vapor pressure.
-!
-!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
-!  temperatures between 223 and 323 K.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision P, the vapor pressure, in MegaPascals.
-!
-
-  implicit none
-
-  double precision p,T
-
-  p=exp(-1.5609d-004*T**2 + 0.1236*T - 9.1530)/1d6
-
-end subroutine psat_NH3
-
-subroutine latheat_NH3 ( T, sc, sv )
-!
-!  PSAT_NH3 makes a rough estimate of the entropies of condensation /
-!  vapourisation.
-! 
-!  Interpolated from www.engineeringtoolbox.com data by RDW 21/09/11 for
-!  temperatures between 223 and 323 K.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision sc, the entropy of condensate, in J kg^-1 K^-1.
-!            double precision sv, the entropy of gas, in J kg^-1 K^-1.
-!
-
-  implicit none
-
-  double precision T,sc,sv
-
-  sv = 0.0492*T**2 - 40.4199*T + 1.2708e+004
-  sc = -0.0215*T**2 + 28.7138*T - 5.5267e+003
-
-  !L = -11.2373*T**2 + 2.5326d+03*T + 1.4099d+06
-
-end subroutine latheat_NH3
-
-
-! ---------------------
-! H2O
-! ---------------------
-
-subroutine base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
-!
-!*******************************************************************************
-!
-!! BASE calculates quantities associated with the base Helmholtz function.
-!
-!
-!  Discussion:
-!
-!    The equation for the base Helmholtz function AB(T,RHO) is:
-!
-!      AB(T,RHO) = R * T * (
-!        - ln ( 1 - y ) 
-!        - ( beta - 1 ) / ( 1 - y ) 
-!        + ( alpha + beta + 1 ) / ( 2 * ( 1 - y )**2 )
-!        + 4 * y * ( ( Bbar / b ) - gamma ) 
-!        - 0.5 * ( alpha - beta + 3 ) 
-!        + ln ( RHO * R * T / P0 ) )
-!                                                      (Equation 2)
-!   where 
-!
-!     y = b * rho / 4, 
-!     alpha = 11,
-!     beta = 133/3, 
-!     gamma = 7/2, 
-!     P0 = 0.101325 MegaPascals = 1 atm
-!
-!   and
-!
-!     b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
-!
-!     Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
-!
-!   where 
-!
-!     T0=647.073 K and the coefficients b(j) and B(j) are
-!    
-!     j    b(j)                         B(j)
-!    --    -----------                  ----------
-!     0    0.7478629                    1.1278334
-!     1   -0.3540782                   -0.5944001
-!     2    0                           -5.010996
-!     3    0.007159876                  0
-!     4    0                            0.63684256
-!     5   -0.003528426                  0
-!
-!  For the derived quantities, the following relations are used:
-!
-!    Pressure:                  PB      = RHO**2 * dAB/dRHO
-!    Density derivative:        DPDRB   = 2*PB/RHO + RHO**2 * d2AB/dRHO2
-!    Temperature derivative:    DPDTB   = RHO**2 * d2AB/(dRHO dT)
-!    Specific entropy:          SB      = ( UB - AB ) / T
-!    Specific internal energy:  UB      = AB + T * SB
-!    Specific enthalpy:         HB      = UB + PB / RHO
-!    Specific heat capacity
-!      at constant volume:      CVB     = - T * d2AB/dT2
-!    Specific Gibbs function:   GB      = AB + PB / RHO
-!
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Modified:
-!
-!    03 February 2002
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Input, double precision RHO, the density, in G/CM3.
-!
-!    Output, double precision AB, the base value of the Helmholtz function,
-!    in KJ/kg.
-!
-!    Output, double precision CVB, the base value of the isochoric (constant 
-!    volume) heat capacity, in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision DPDRB, the base value of the partial
-!    derivative dP(T,RHO)/dRHO, with T held fixed, in (MegaPascals CM3)/G.
-!
-!    Output, double precision DPDTB, the base value of the partial
-!    derivative dP(T,RHO)/dT, with RHO held fixed, in 
-!    MegaPascals/degrees Kelvin.
-!
-!    Output, double precision GB, the base value of the Gibbs free energy,
-!    in KJ/kg.
-!
-!    Output, double precision HB, the base value of enthalpy, in KJ/kg.
-!
-!    Output, double precision PB, the base pressure, in MegaPascals.
-!
-!    Output, double precision SB, the base value of entropy, 
-!    in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision UB, the base value of internal energy, 
-!    in KJ/kg.
-!
-  implicit none
-!
-  double precision ab
-  double precision, parameter :: alpha = 11.0D+00
-  double precision b1
-  double precision b1t
-  double precision b1tt
-  double precision b2
-  double precision b2t
-  double precision b2tt
-  double precision, parameter :: beta = 44.333333333333D+00
-  double precision cvb
-  double precision dpdrb
-  double precision dpdtb
-  double precision dz
-  double precision dz0
-  double precision, parameter :: gamma = 3.5D+00
-  double precision gascon
-  double precision gb
-  double precision hb
-  double precision, parameter :: p_zero = 0.101325D+00
-  double precision pb
-  double precision rho
-  double precision sb
-  double precision t
-  double precision ub
-  double precision x
-  double precision y
-  double precision z
-  double precision z0
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'BASE - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-!
-!  Refuse to handle zero or negative density.
-!
-  if ( rho <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'BASE - Fatal error!'
-    write ( *, '(a)' ) '  The input density RHO must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
-    stop
-  end if
-!
-!  Compute auxilliary quantities for Equation 2.
-!
-  call bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
-
-  y = 0.25D+00 * b1 * rho
-
-  x = 1.0D+00 - y
-!
-!  Evaluate Equation 2.
-!
-  ab =   - log ( 1.0D+00 - y ) &
-         - ( beta - 1.0D+00 ) / ( 1.0D+00 - y ) &
-         + ( alpha + beta + 1.0D+00 ) / ( 2.0D+00 * ( 1.0D+00 - y )**2 ) &
-         + 4.0D+00 * y * ( ( b2 / b1 ) - gamma ) &
-         - 0.5D+00 * ( alpha - beta + 3.0D+00 ) &
-         + log ( rho * gascon() * t / p_zero )
-!
-!  Determine quantities defined in terms of AB.
-!
-  pb = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3 &
-    + 4.0D+00 * y * ( b2 / b1 - gamma )
-
-  z0 = ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**3
-
-  z = z0 + 4.0D+00 * y * ( b2 / b1 - gamma )
-
-  dz0 = ( alpha + 2.0D+00 * beta * y ) / ( 1.0D+00 - y )**3 &
-    + 3.0D+00 * ( 1.0D+00 + alpha * y + beta * y**2 ) / ( 1.0D+00 - y )**4
-
-  dz = dz0 + 4.0D+00 * ( b2 / b1 - gamma )
-
-  gb = ab + pb
-
-  ub = - t * b1t * ( pb - 1.0D+00 - rho * b2 ) / b1 - rho * t * b2t
-
-  hb = pb + ub
-!
-!  An incorrect version of this equation began:
-!
-!    cvb = 2.0D+00 * ub + ( pb - 1.0D+00 ) &
-!
-!  and caused me no end of trouble.  My fault, JVB, 03 February 2002
-!
-  cvb = 2.0D+00 * ub + ( z0 - 1.0D+00 ) &
-    * ( ( t * b1t / b1 )**2 - t**2 * b1tt / b1 ) &
-    - rho * t**2 * ( b2tt - gamma * b1tt ) - ( t * b1t / b1 )**2 * y * dz0
-
-  dpdtb = pb / t + rho * ( 0.25D+00 * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) ) &
-    * b1t + b2t - b2 / b1 * b1t )
-
-  sb = ub - ab
-
-  dpdrb = pb + y * ( dz0 + 4.0D+00 * ( b2 / b1 - gamma ) )
-!
-!  Assign dimensions.
-!
-  ab =    gascon() * t       * ab
-  cvb =   gascon()           * cvb
-  dpdrb = gascon() * t       * dpdrb
-  dpdtb = gascon() * t * rho * dpdtb
-  gb =    gascon() * t       * gb
-  hb =    gascon() * t       * hb
-  pb =    gascon() * t * rho * pb
-  sb =    gascon()           * sb
-  ub =    gascon() * t       * ub
-
-  return
-end subroutine base
-
-subroutine bb ( t, b1, b2, b1t, b2t, b1tt, b2tt )
-!
-!*******************************************************************************
-!
-!! BB calculates the B's of equations 3 and 4.  
-!
-!
-!  Discussion:
-!
-!    Here
-!
-!      b(T) = b1 * ln(T/T0) + sum(j=0,1,3,5) b(j)*(T0/T)**j  (Equation 3)
-!
-!      Bbar(T) = sum(j=0,1,2,4) B(j)*(T0/T)**j               (Equation 4).
-!
-!    where 
-!
-!      T0 = 647.073 K 
-!
-!    and the coefficients b(j) and B(j) are
-!    
-!      j    b(j)                         B(j)
-!     --    -----------                  ----------
-!      0    0.7478629                    1.1278334
-!      1   -0.3540782                   -0.5944001
-!      2    0                           -5.010996
-!      3    0.007159876                  0
-!      4    0                            0.63684256
-!      5   -0.003528426                  0
-!
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision B1, the coefficient b from equation 3, 
-!    in CM3/G.
-!
-!    Output, double precision B2, the coefficient Bbar from equation 4, 
-!    in CM3/G.
-!
-!    Output, double precision B1T, the derivative dB1/dT, 
-!    in (CM3)/(G Degrees Kelvin).
-!
-!    Output, double precision B2T, the derivative dB2/dT, 
-!    in (CM3)/(G Degrees Kelvin).
-!
-!    Output, double precision B1TT, the second derivative of B1 with 
-!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
-!
-!    Output, double precision B2TT, the second derivative of B2 with 
-!    respect to T, in (CM3)/(G (Degrees Kelvin)**2 ).
-!
-  implicit none
-!
-  double precision b1
-  double precision b1t
-  double precision b1tt
-  double precision b2
-  double precision b2t
-  double precision b2tt
-  double precision, parameter, dimension ( 10 ) :: bp = (/ &
-    0.7478629D+00,   -0.3540782D+00,    0.0D+00,           0.0D+00, &
-    0.007159876D+00,  0.0D+00,         -0.003528426D+00,   0.0D+00, &
-    0.0D+00,          0.0D+00 /)
-  double precision, parameter, dimension ( 10 ) :: bq = (/ &
-    1.1278334D+00,    0.0D+00,         -0.5944001D+00,   -5.010996D+00, &
-    0.0D+00,          0.63684256D+00,   0.0D+00,          0.0D+00, &
-    0.0D+00,          0.0D+00 /)
-  integer i
-  double precision t
-  double precision, parameter :: t_ref = 647.073D+00
-  double precision v(10)
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'BB - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-!
-!  Set V(I) = ( T_REF / T )**(I-1).
-!
-  v(1) = 1.0D+00
-  do i = 2, 10
-    v(i) = v(i-1) * t_ref / t
-  end do
-!
-!  Set B1, B1T, B1TT.
-!
-  b1 = bp(1) + bp(2) * log ( 1.0D+00 / v(2) )
-  b1t = bp(2) * v(2) / t_ref
-  b1tt = 0.0D+00
-  do i = 3, 10
-    b1 = b1 + bp(i) * v(i-1)
-    b1t = b1t - dble ( i - 2 ) * bp(i) * v(i-1) / t
-    b1tt = b1tt + bp(i) * dble ( i - 2 )**2 * v(i-1) / t**2
-  end do
-
-  b1tt = b1tt -  ( b1t / t )
-!
-!  Set B2, B2T, B2TT.
-!
-  b2 = bq(1)
-  b2t = 0.0D+00
-  b2tt = 0.0D+00
-  do i = 3, 10
-    b2 = b2 + bq(i) * v(i-1)
-    b2t = b2t - dble ( i - 2 ) * bq(i) * v(i-1) / t
-    b2tt = b2tt + bq(i) * dble ( i - 2 )**2 * v(i-1) / t**2
-  end do
-
-  b2tt = b2tt - ( b2t / t )
-
-  return
-end subroutine bb
-
-
-subroutine ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
-!
-!*******************************************************************************
-!
-!! IDEAL computes ideal gas thermodynamic properties of water.
-!
-!
-!  Discussion:
-!
-!    Values for thermodynamic properties of water in the ideal
-!    gas state were reported by Woolley.  The formula for the ideal gas
-!    term of the Helmholtz function approximates a term by term summation of 
-!    contributions from each of the rotation and vibration states.  
-!    The formula, equation #6 in the reference, is:
-!   
-!    A(ideal)(T) = -R * T * ( 1 + ( C(1)/Tr + C(2) ) * ln(Tr)
-!      + Sum ( 3 <= I <= 18) C(I) * Tr**(I-6)
-!   
-!    where Tr=T/100 K.  The C(i) are tabulated coefficients.  Equation
-!    6 can be used for temperatures below 3000 K, and is accurate to
-!    within the tolerance of the gas constant for 50<=T<=2000 K.
-!     
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision AI, the Helmholtz function, in KJ/kg.
-!
-!    Output, double precision CPI, the heat capacity at constant pressure,
-!    in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision CVI, the heat capacity at constant volume,
-!    in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision GI, the Gibbs free energy, in KJ/kg.
-!
-!    Output, double precision HI, the enthalpy, in KJ/kg.
-!
-!    Output, double precision SI, the entropy, in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision UI, the internal energy, in KJ/kg.
-!
-  implicit none
-!
-  double precision ai
-  double precision, parameter, dimension ( 18 ) :: c = (/ &
-   19.730271018D+00,      20.9662681977D+00,     -0.483429455355D+00, &
-    6.05743189245D+00,    22.56023885D+00,       -9.87532442D+00, &
-   -4.3135538513D+00,      0.458155781D+00,      -0.047754901883D+00, &
-    0.0041238460633D+00,  -0.00027929052852D+00,  0.14481695261D-04, &
-   -0.56473658748D-06,     0.16200446D-07,       -0.3303822796D-09, &
-    0.451916067368D-11,   -0.370734122708D-13,    0.137546068238D-15 /)
-  double precision cpi
-  double precision cvi
-  double precision gascon
-  double precision gi
-  double precision hi
-  integer i
-  double precision si
-  double precision t
-  double precision temp
-  double precision tt
-  double precision ui
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'IDEAL - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-
-  tt = t / 100.0D+00
-
-  gi = - ( c(1) / tt + c(2) ) * log ( tt )
-  do i = 3, 18
-    gi = gi - c(i) * tt**(i-6)
-  end do
-
-  hi = c(2) + c(1) * ( 1.0D+00 - log ( tt ) ) / tt
-  do i = 3, 18
-    hi = hi + dble ( i - 6 ) * c(i) * tt**(i-6)
-  end do
-
-  cpi = c(2) - c(1) / tt
-  do i = 3, 18
-    cpi = cpi + dble ( ( i - 6 ) * ( i - 5 ) ) * c(i) * tt**(i-6)
-  end do
-
-  ai = gi - 1.0D+00
-  ui = hi - 1.0D+00
-  cvi = cpi - 1.0D+00
-  si = hi - gi
-!
-!  Assign dimensions.
-!
-  ai =  gascon() * t * ai
-  cpi = gascon()     * cpi
-  cvi = gascon()     * cvi
-  gi =  gascon() * t * gi
-  hi =  gascon() * t * hi
-  si =  gascon()     * si
-  ui =  gascon() * t * ui
-
-  return
-end subroutine ideal
-
-
-subroutine resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
-!
-!*******************************************************************************
-!
-!! RESID calculates residual contributions to thermodynamic quantities.
-!
-!
-!  Discussion:
-!
-!    The residual function consists of 40 terms.  The first 36 are
-!    used in a global least squares fit to experimental data.
-!
-!    Three terms were added that contribute only in the immediate
-!    neighborhood of the critical point 
-!      (tk-5) <= T <= (tk+5) C
-!      0.20   <= rho <= 0.44 g/cm3, 
-!
-!    A single term was added for the region of high pressure and 
-!    low temperature: T < 75 C, P > 300 MPa.
-!
-!    Except in these limited regions, the residual function is
-!    given by the first 36 terms.  The equation is
-!   
-!      A(residual)(rho,T)=
-!        sum(i=1 to 36) (g(i)/k(i)) * (T0/T)**(l(i)) (1-exp(-rho))**(k(i))
-!      + sum(i=37 to 40) g(i)*delta(i)**(k(i))
-!        * exp(-alpha(i)*delta(i)**(k(i)) - beta(i)*tau(i)**2)
-!                                                     (Equation 5)
-!   
-!    where
-!
-!      g(i) are coefficients determined by fits to data,
-!      delta(i) are reduced densities (delta(i)=((rho-rho(i))/rho(i))
-!      tau(i) are reduced temperatures (tau(i)=((T-tau(i))/tau(i))
-!      rho(i) are specified densities.
-!      tau(i) are specified temperatures.
-!      The k(i) and l(i) are specified integers.
-!   
-!  Modified:
-!
-!    22 November 1998
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Input, double precision RHO, the density, in G/CM3.
-!
-!    Output, double precision AR, the residual contribution to the 
-!    Helmholtz function, in KJ/kg.
-!
-!    Output, double precision CVR, the residual contribution to the 
-!    isochoric (constant volume) heat capacity, in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision DPDRR, the residual contribution to 
-!    the partial derivative dP(T,RHO)/dRHO, with T held fixed, in 
-!    (MegaPascals CM3)/G.
-!
-!    Output, double precision DPDTR, the residual contribution to 
-!    the partial derivative dP(T,RHO)/dT, with RHO held fixed, 
-!    in MegaPascals/degrees Kelvin.
-!
-!    Output, double precision GR, the residual contribution to the Gibbs 
-!    function, in KJ/kg.
-!
-!    Output, double precision HR, the residual contribution to the 
-!    enthalpy, in KJ/kg.
-!
-!    Output, double precision PR, the residual contribution to the pressure, 
-!    in MegaPascals.
-!
-!    Output, double precision SR, the residual contribution to the entropy, 
-!    in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision UR, the residual contribution to the 
-!    internal energy, in KJ/kg.
-!
-  implicit none
-!
-  double precision, parameter, dimension ( 4 ) :: aad = (/ &
-    34.0D+00, 40.0D+00, 30.0D+00, 1050.0D+00 /)
-  double precision, parameter, dimension ( 4 ) :: aat = (/ &
-    20000.0D+00, 20000.0D+00, 40000.0D+00, 25.0D+00 /)
-  double precision, parameter, dimension ( 4 ) :: adz = (/ &
-    0.319D+00, 0.319D+00, 0.319D+00, 1.55D+00 /)
-  double precision ar
-  double precision att
-  double precision, parameter, dimension ( 4 ) ::  atz = (/ &
-    640.0D+00, 640.0D+00, 641.6D+00, 270.0D+00 /)
-  double precision cvr
-  double precision dadt
-  double precision ddz
-  double precision del
-  double precision dex
-  double precision dfdt
-  double precision dpdrr
-  double precision dpdtr
-  double precision e
-  double precision errtol
-  double precision ex0
-  double precision ex1
-  double precision ex2
-  double precision fct
-  double precision, parameter, dimension ( 40 ) :: g = (/ &
-    -530.62968529023D+00,  0.22744901424408D+04, 0.78779333020687D+03, &
-    -69.830527374994D+00,  0.17863832875422D+05,-0.39514731563338D+05, &
-    0.33803884280753D+05, -0.13855050202703D+05,-0.25637436613260D+06, &
-    0.48212575981415D+06, -0.34183016969660D+06, 0.12223156417448D+06, &
-    0.11797433655832D+07, -0.21734810110373D+07, 0.10829952168620D+07, &
-   -0.25441998064049D+06, -0.31377774947767D+07, 0.52911910757704D+07, &
-   -0.13802577177877D+07, -0.25109914369001D+06, 0.46561826115608D+07, &
-   -0.72752773275387D+07,  0.41774246148294D+06, 0.14016358244614D+07, &
-   -0.31555231392127D+07,  0.47929666384584D+07, 0.40912664781209D+06, &
-   -0.13626369388386D+07,  0.69625220862664D+06,-0.10834900096447D+07, &
-   -0.22722827401688D+06,  0.38365486000660D+06, 0.68833257944332D+04, &
-    0.21757245522644D+05, -0.26627944829770D+04,-0.70730418082074D+05, &
-   -0.225D+00, -1.68D+00, 0.055D+00, -93.0D+00 /)
-  double precision gascon
-  double precision gr
-  double precision hr
-  integer i
-  integer, parameter, dimension ( 40 ) :: ii = (/ &
-    0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6, &
-    8,8,8,8,2,2,0,4,2,2,2,4 /)
-  integer j
-  integer, parameter, dimension ( 40 ) :: jj = (/ &
-    2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,2,3,5,7,&
-    2,3,5,7,1,4,4,4,0,2,0,0 /)
-  integer k
-  integer l
-  integer nc
-  double precision pr
-  double precision q10
-  double precision q20
-  double precision q2a
-  double precision q5t
-  double precision qm
-  double precision qp
-  double precision qr(11)
-  double precision qt(10)
-  double precision rho
-  double precision sr
-  double precision, parameter :: s_ref = 7.6180720166752D+00
-  double precision t
-  double precision, parameter :: t_ref = 647.073D+00
-  double precision tau
-  double precision tx
-  double precision, parameter :: u_ref = - 4328.4549774261D+00
-  double precision ur
-  double precision v
-!
-  errtol = sqrt ( epsilon ( errtol ) )
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'RESID - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-!
-!  Refuse to handle zero or negative density.
-!
-  if ( rho <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'RESID - Fatal error!'
-    write ( *, '(a)' ) '  The input density RHO must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
-    stop
-  end if
-
-  nc = 36
-  dpdrr = 0.0D+00
-  pr = 0.0D+00
-  ar = 0.0D+00
-  dadt = 0.0D+00
-  cvr = 0.0D+00
-  dpdtr = 0.0D+00
-
-  ex0 = - rho
-! ex0 = max ( ex0, - 225.0D+00 )
-! ex0 = min ( ex0, 225.0D+00 )
-  e = exp ( ex0 )
-
-  q10 = rho * rho * e
-  q20 = 1.0D+00 - e
-
-  qr(1) = 0.0D+00
-  qr(2) = q10
-  do i = 2, 10
-    qr(i+1) = qr(i) * q20
-  end do
-
-  v = t_ref / t
-  qt(1) = t / t_ref
-  do i = 2, 10
-    qt(i) = qt(i-1) * v
-  end do
-
-  do i = 1, nc
-
-    k = ii(i) + 1
-    l = jj(i)
-    qp = g(i) * qr(k+1) * qt(l+1)
-    pr = pr + qp
-
-    dpdrr = dpdrr + ( 2.0D+00 / rho - ( 1.0D+00 - e * dble ( k - 1 ) / &
-      ( 1.0D+00 - e ) ) ) * qp
-
-    ar = ar + g(i) * qr(k+2) * qt(l+1) / ( rho**2 * e * dble ( k ) &
-      * gascon ( ) * t )
-
-    dfdt = ( 1.0D+00 - e )**k * dble ( 1 - l ) * qt(l+2) / t_ref / dble ( k )
-
-    dadt = dadt + g(i) * dfdt
-
-    dpdtr = dpdtr + g(i) * dfdt * rho**2 * e * dble ( k ) / ( 1.0D+00 - e )
-
-    cvr = cvr + g(i) * dble ( l ) * dfdt / gascon()
-
-  end do
-
-  qp = 0.0D+00
-  q2a = 0.0D+00
-
-  do j = 37, 40
-
-    k = ii(j)
-    ddz = adz(j-36)
-    del = rho / ddz - 1.0D+00
-
-    if ( abs ( del ) < errtol ) then
-      del = errtol
-    end if
-
-    ex1 = - aad(j-36) * del**k
-!   ex1 = max ( ex1, - 225.0D+00 )
-!   ex1 = min ( ex1, 225.0D+00 )
-    dex = exp ( ex1 ) * del**jj(j)
-
-    att = aat(j-36)
-    tx = atz(j-36)
-    tau = ( t / tx ) - 1.0D+00
-
-    ex2 = - att * tau**2
-!   ex2 = max ( ex2, - 225.0D+00 )
-!   ex2 = min ( ex2, 225.0D+00 )
-    q10 = dex * exp ( ex2 )
-
-    qm = dble ( jj(j) ) / del - dble ( k ) * aad(j-36) * del**(k-1)
-    fct = qm * rho**2 * q10 / ddz
-
-    q5t = fct * ( 2.0D+00 / rho + qm / ddz ) - ( rho / ddz )**2 * q10 * &
-      ( dble ( jj(j) ) / del**2 + dble ( k * ( k - 1 ) ) * aad(j-36) * &
-      del**(k-2) )
-
-    dpdrr = dpdrr + q5t * g(j)
-    qp = qp + g(j) * fct
-    dadt = dadt - 2.0D+00 * g(j) * att * tau * q10 / tx
-    dpdtr = dpdtr - 2.0D+00 * g(j) * att * tau * fct / tx
-
-    q2a = q2a + t * g(j) * att * ( 4.0D+00 * ex2 + 2.0D+00 ) * q10 / tx**2
-
-    ar = ar + q10 * g(j) / ( gascon() * t )
-
-  end do
-
-  cvr = cvr + q2a / gascon()
-  pr = pr + qp
-  sr = - dadt / gascon()
-  ur = ar + sr
-!
-!  Assign dimensions.
-!
-  ar =  gascon() * t *  ar
-  cvr = gascon() *     cvr
-  sr =  gascon() *      sr
-  ur =  gascon() * t *  ur
-!
-!  Adjust energies.
-!
-  ar = ar + gascon ( ) * t * s_ref - gascon ( ) * u_ref
-  sr = sr - gascon ( ) * s_ref
-  ur = ur - gascon ( ) * u_ref
-
-  gr = ar + pr / rho
-  hr = ur + pr / rho
-
-  return
-end subroutine resid
-
-subroutine psat_H2O ( t, p )
-!
-!*******************************************************************************
-!
-!! PSAT_H2O makes a rough estimate of the vapor pressure.
-!
-!
-!  Discussion:
-!
-!    The calculation agrees with tabulated data to within
-!    0.02% for temperature to within a degree or so of the critical
-!    temperature.  The approximate vapor pressure can be refined
-!    by imposing the condition that the Gibbs functions of the vapor
-!    and liquid phases be equal.
-!
-!  Modified:
-!
-!    21 November 1998
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision P, the vapor pressure, in MegaPascals.
-!
-  implicit none
-!
-  double precision, parameter, dimension ( 8 ) :: a = (/ &
-    -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
-    -105.38479D+00,   174.35319D+00,  -148.39348D+00, 48.631602D+00 /)
-  double precision b
-  integer i
-  double precision p
-  double precision q
-  double precision t
-  double precision, parameter :: t_ref = 647.25D+00
-  double precision v
-  double precision w
-  double precision z
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'PSAT_H2O - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-
-  if ( t <= 314.0D+00 ) then
-
-    p = 0.1D+00 * exp ( 6.3573118D+00 - 8858.843D+00 / t &
-      + 607.56335D+00 * t**( -0.6D+00 ) )
-
-  else
-
-    v = t / t_ref
-    w = abs ( 1.0D+00 - v )
-    b = 0.0D+00
-    do i = 1, 8
-      z = i
-      b = b + a(i) * w**( ( z + 1.0D+00 ) / 2.0D+00 )
-    end do
-
-    q = b / v
-    p = 22.093D+00 * exp ( q )
-
-  end if
-
-  return
-end subroutine psat_H2O
-
-
-subroutine tdpsdt ( t, dp )
-!
-!*******************************************************************************
-!
-!! TDPSDT computes the quantity T * dP(Sat)/dT.
-!
-!
-!  Discussion:
-!
-!    Here T is the temperature and P(Sat) is the vapor pressure.  
-!    It is used by TSAT_EST and TSAT.
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Output, double precision DP, the value T*(dP(Sat)/dT), 
-!    in MegaPascals.
-!
-  implicit none
-!
-  double precision, parameter, dimension ( 8 ) :: a = (/ &
-      -7.8889166D+00,   2.5514255D+00,   -6.716169D+00, 33.239495D+00, &
-    -105.38479D+00,   174.35319D+00,   -148.39348D+00,  48.631602D+00 /)
-  double precision b
-  double precision c
-  double precision dp
-  integer i
-  double precision q
-  double precision t
-  double precision, parameter :: t_ref = 647.25D+00
-  double precision v
-  double precision w
-  double precision y
-  double precision z
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'TDPSDT - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-
-  v = t / t_ref
-  w = 1.0D+00 - v
-  b = 0.0D+00
-  c = 0.0D+00
-  do i = 1, 8
-    z = dble ( i + 1 ) / 2.0D+00
-    y = a(i) * w**z
-    c = c + ( y / w ) * ( 0.5D+00 - 0.5D+00 * dble ( i ) - 1.0D+00 / v )
-    b = b + y
-  end do
-
-  q = b / v
-  dp = 22.093D+00 * exp ( q ) * c
-
-  return
-end subroutine tdpsdt
-
-
-
-subroutine therm ( t, rho, a, cjth, cjtt, cp, cv, dpdr, dpdt, g, h, p, s, u )
-!
-!*******************************************************************************
-!
-!! THERM calculates thermodynamic functions given temperature and density.
-!
-!
-!  Discussion:
-!
-!    Thermodynamic values were calculated from an analytic equation
-!    that approximates the Helmholtz function (specific Helmholtz
-!    energy) for ordinary water and steam, of the form A=A(rho,T)
-!    where A is the Helmholtz function, rho the density, and T
-!    the absolute (thermodynamic) temperature.  Any thermodynamic
-!    value for any state, liquid, vapor or metastable, may be
-!    calculated by differentiation of this equation in accord with
-!    the first and second laws of thermodynamics.
-! 
-!    The International Association for the Properties of Steam
-!    has provisionally accepted this formulation for the range
-!    273.15 <= T <= 1273.15 degrees Kelvin, where, for 423.15 <= T,
-!    the maximum pressure is Pmax = 1500 MPa = 15000 bar, and for
-!    273.15 <= T < 423.15, the maximum pressure is
-!    Pmax = 100 * (5 + (T-273.15)/15) MPa.
-! 
-!    Close to the critical point, a small region is excluded:
-!    Abs(T-Tk) < 1, abs((rho-rhok)/rhok) < 0.3.
-! 
-!    The equation has a wider useful range, namely, fluid states
-!    of pure, undissociated water and steam defined by
-!    260 <= T <= 2500 K and 0 <= P <= 3000 MPa.
-! 
-!    Thermodynamic property values for specific volume, density,
-!    specific internal energy, specific enthalpy, and specific
-!    entropy of water and steam were tabulated over the range
-!    0 <= t <= 2000 C, 0 <= P <= 3000 MPa.  The reference
-!    state is the liquid at the triple point, for which the
-!    internal energy and entropy have been assigned the value zero.
-!     
-!    Thermodynamic quantities are determined from the Helmholtz function
-!    A(rho,T), which is computed as the sum of three terms:
-!
-!      A(rho,T) = A(base)(rho,T) + A(residual)(rho,T) + A(ideal)(T)
-!                                                       (Equation 1)
-!
-!    Because A(rho,T) is everywhere single valued and analytic,
-!    we can derive closed form relations for all other properties.
-!    In the following, unless otherwise indicated, the independent
-!    variables are temperature T and density RHO, and differentiation
-!    with respect to one variable is to imply that the other is fixed.
-! 
-!    Pressure:                  P       = RHO**2 * dA/dRHO
-!    Density derivative:        dP/dRHO = 2*P/RHO + RHO**2 * d2A/dRHO2
-!    Temperature derivative:    dP/dT   = RHO**2 * d2A/(dRHO dT)
-!    Specific entropy:          S       = - dA/dT
-!    Specific internal energy:  U       = A + T*S
-!    Specific enthalpy:         H       = U + P/RHO
-!    Specific heat capacity
-!      at constant volume:      Cv      = - T * d2A/dT2
-!    Specific Gibbs function:   G       = A + P/RHO
-!    Specific heat capacity
-!      at constant pressure:    Cp      = Cv + (T*(dP/dT)**2)/(RHO**2*dP/dRHO)
-!    Speed of sound:            Omega   = Sqrt ((Cp/Cv) * dP/dRHO)
-!    Second virial coefficient: B       = 1/(2*R*T) * (d2P/dRHO2) (at RHO=0)
-!    Isothermal Joule-Thomson
-!      coefficient:             DeltaT  = (dH/dP) (fixed T) =
-!                                         (1/RHO)-(T*dP/dT)/(RHO**2*dP/dRHO)
-!    Joule-Thomson coefficient: Mu      = (dT/dP) (fixed H) = DeltaT/Cp
-!    Isentropic temperature-
-!      pressure coefficient:    BetaS   = (dT/dP) (fixed S) =
-!                                         (DeltaT - 1/RHO)/Cp
-!   
-!  Modified:
-!
-!    19 November 1998
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Input, double precision T, the temperature, in degrees Kelvin.
-!
-!    Input, double precision RHO, the fluid density, in G/CM3.
-!
-!    Output, double precision A, the Helmholtz function, in KJ/kg.
-!
-!    Output, double precision CJTH, the Joule-Thomson coefficient,
-!    in K/MegaPascals.
-!
-!    Output, double precision CJTT, the isothermal Joule-Thomson coefficient,
-!    in CM3/G.
-!
-!    Output, double precision CP, the isobaric (constant pressure) heat
-!    capacity, in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision CV, the isochoric (constant volume) heat capacity,
-!    in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision DPDR, the partial derivative 
-!    dP(T,RHO)/dRHO, with T held fixed, in MegaPascals*CM3/G.
-!
-!    Output, double precision DPDT, the partial derivative 
-!    dP(T,RHO)/dT, with RHO held fixed, in MegaPascals/degrees Kelvin.
-!
-!    Output, double precision G, the Gibbs free energy, in KJ/kg.
-!
-!    Output, double precision H, the enthalpy, in KJ/kg.
-!
-!    Output, double precision P, the pressure, in MegaPascals.
-!
-!    Output, double precision S, the entropy, in KJ/(kg degrees Kelvin).
-!
-!    Output, double precision U, the internal energy, in KJ/kg.
-!
-  implicit none
-!
-  double precision a
-  double precision ab
-  double precision ai
-  double precision ar
-  double precision cjth
-  double precision cjtt
-  double precision cp
-  double precision cpi
-  double precision cv
-  double precision cvb
-  double precision cvi
-  double precision cvr
-  logical, parameter :: debug = .false.
-!  logical, parameter :: debug = .true.
-  double precision dpdr
-  double precision dpdrb
-  double precision dpdrr
-  double precision dpdt
-  double precision dpdtb
-  double precision dpdtr
-  double precision g
-  double precision gb
-  double precision gi
-  double precision gr
-  double precision h
-  double precision hb
-  double precision hi
-  double precision hr
-  double precision p
-  double precision pb
-  double precision pr
-  double precision rho
-  double precision s
-  double precision sb
-  double precision si
-  double precision sr
-  double precision t
-  double precision u
-  double precision ub
-  double precision ui
-  double precision ur
-!
-!  Refuse to handle zero or negative temperatures.
-!
-  if ( t <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'THERM - Fatal error!'
-    write ( *, '(a)' ) '  The input temperature T must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was T = ', t
-    stop
-  end if
-!
-!  Refuse to handle zero or negative density.
-!
-  if ( rho <= 0.0D+00 ) then
-    write ( *, '(a)' ) ' '
-    write ( *, '(a)' ) 'THERM - Fatal error!'
-    write ( *, '(a)' ) '  The input density RHO must be positive.'
-    write ( *, '(a,g14.6)' ) '  Input value was RHO = ', rho
-    stop
-  end if
-
-  call ideal ( t, ai, cpi, cvi, gi, hi, si, ui )
-
-  call resid ( t, rho, ar, cvr, dpdrr, dpdtr, gr, hr, pr, sr, ur )
-
-  call base ( t, rho, ab, cvb, dpdrb, dpdtb, gb, hb, pb, sb, ub )
-
-  a =       ab +    ar +  ai
-  cv =     cvb +   cvr + cvi
-
-  if ( debug ) then
-    write ( *, * ) ' '
-    write ( *, * ) 'THERM:'
-    write ( *, * ) '  CVB = ', cvb
-    write ( *, * ) '  CVR = ', cvr
-    write ( *, * ) '  CVI = ', cvi
-    write ( *, * ) '  CV  = ', cv
-  end if
-
-
-  dpdr = dpdrb + dpdrr
-  dpdt = dpdtb + dpdtr
-  p =       pb +    pr
-  s =       sb +    sr +  si
-  u =       ub +    ur +  ui
-
-  if ( debug ) then
-    write ( *, * ) ' '
-    write ( *, * ) 'THERM:'
-    write ( *, * ) '  UB = ', ub
-    write ( *, * ) '  UR = ', ur
-    write ( *, * ) '  UI = ', ui
-  end if
-
-  g = a + p / rho
-  h = u + p / rho
-  cp = cv + t * dpdt**2 / ( dpdr * rho**2 )
-  cjtt = 1.0D+00 / rho - t * dpdt / ( dpdr * rho**2 )
-  cjth = - cjtt / cp
-
-  return
-end subroutine therm
-
-function gascon ( )
-!
-!*******************************************************************************
-!
-!! GASCON returns the value of the specific gas constant.
-!
-!
-!  Note:
-!
-!    The specific gas constant R is related to the universal gas
-!    constant R-bar = 8.31441 J/(mol degrees Kelvin) by the molar mass 
-!    M = 18.0152 g/mol:
-!
-!      R = R-bar / M.
-!
-!  Reference:
-!
-!    Lester Haar, John Gallagher and George Kell,
-!    NBS/NRC Steam Tables:
-!    Thermodynamic and Transport Properties and Computer Programs
-!      for Vapor and Liquid States of Water in SI Units,
-!    Hemisphere Publishing Corporation, Washington, 1984,
-!    TJ270.H3
-!
-!    C A Meyer, R B McClintock, G J Silvestri, R C Spencer,
-!    ASME Steam Tables: Thermodynamic and Transport Properties of Steam,
-!    American Society of Mechanical Engineers, 1967.
-!
-!  Parameters:
-!
-!    Output, double precision GASCON, the value of the specific gas 
-!    constant, in J/(g degrees Kelvin).
-!
-  implicit none
-!
-  double precision gascon
-!
-  gascon = 0.461522D+00
- 
-  return
-end function gascon
Index: unk/LMDZ.GENERIC/libf/phystd/rcm1d.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/rcm1d.F	(revision 1402)
+++ 	(revision )
@@ -1,927 +1,0 @@
-      program rcm1d
-
-! to use  'getin'
-      use ioipsl_getincom, only: getin
-      use infotrac, only: nqtot, tname
-      use surfdat_h, only: albedodat, phisfi, dryness, watercaptag,
-     &                     zmea, zstd, zsig, zgam, zthe,
-     &                     emissiv, emisice, albedice, iceradius,
-     &                     dtemisice
-      use comdiurn_h, only: sinlat, coslat, sinlon, coslon
-!      use comsaison_h
-      use comsoil_h, only: nsoilmx, layer, mlayer, inertiedat, volcapa
-      USE comgeomfi_h, only: lati, long, area
-      use control_mod, only: day_step, ecritphy
-      use phyredem, only: physdem0,physdem1
-      use comgeomphy, only: initcomgeomphy
-      use slab_ice_h, only: noceanmx
-      use planete_mod, only: apoastr,periastr,year_day,peri_day,
-     &         obliquit,nres,z0,lmixmin,emin_turb,coefvis,coefir,
-     &         timeperi,e_elips,p_elips
-      use comcstfi_mod, only: pi, cpp, daysec, dtphys, rad, g, r,
-     &                        mugaz, rcp, omeg
-      use callkeys_mod, only: tracer,check_cpp_match,rings_shadow,
-     &		specOLR,water,pceil,ok_slab_ocean
-      implicit none
-
-!==================================================================
-!     
-!     Purpose
-!     -------
-!     Run the physics package of the universal model in a 1D column.
-!     
-!     It can be compiled with a command like (e.g. for 25 layers):
-!                                  "makegcm -p std -d 25 rcm1d"
-!     It requires the files "callphys.def", "z2sig.def",
-!     "traceur.def", and "run.def" with a line "INCLUDEDEF=callphys.def"
-!
-!     Authors
-!     -------
-!     Frederic Hourdin
-!     R. Fournier
-!     F. Forget
-!     F. Montmessin (water ice added)
-!     R. Wordsworth
-!     B. Charnay
-!     A. Spiga
-!     J. Leconte (2012)
-!
-!==================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-!include "dimphys.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "logic.h"
-#include "comgeom.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unitstart      ! unite d'ecriture de "startfi"
-      INTEGER nlayer,nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day           ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(llm+1) ! intermediate pressure levels (pa)
-      REAL psurf,tsurf(1)      
-      REAL u(llm),v(llm)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(llm)   ! temperature at the middle of the layers
-      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
-      REAL,ALLOCATABLE :: qsurf(:)      ! tracer surface budget (e.g. kg.m-2)
-      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
-!      REAL co2ice           ! co2ice layer (kg.m-2) !not used anymore
-      integer :: i_co2_ice=0  ! tracer index of co2 ice
-      integer :: i_h2o_ice=0  ! tracer index of h2o ice
-      integer :: i_h2o_vap=0  ! tracer index of h2o vapor
-      REAL emis(1)             ! surface layer
-      REAL q2(llm+1)   ! Turbulent Kinetic Energy
-      REAL zlay(llm)   ! altitude estimee dans les couches (km)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(llm),dv(llm),dtemp(llm)
-      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
-      REAL,ALLOCATABLE :: dq(:,:)
-      REAL,ALLOCATABLE :: dqdyn(:,:)
-
-c   Various intermediate variables
-!      INTEGER thermo
-      REAL zls
-      REAL phi(llm),h(llm),s(llm)
-      REAL pks, ptif, w(llm)
-      INTEGER ierr, aslun
-      REAL tmp1(0:llm),tmp2(0:llm)
-      Logical  tracerdyn
-      integer :: nq !=1 ! number of tracers
- 
-      character*2 str2
-      character (len=7) :: str7
-
-      logical oldcompare, earthhack,saveprofile
-
-!     added by RW for zlay computation
-      real Hscale, Hmax, rho, dz
-
-!     added by RW for autozlevs computation
-      real nu, xx, pMIN, zlev, Htop
-      real logplevs(llm)
-
-!     added by BC
-      REAL cloudfrac(1,llm)
-      REAL hice(1),totcloudfrac(1)
-      REAL qzero1D   !initial water amount on the ground
-
-!     added by BC for ocean
-      real rnat(1)
-      REAL tslab(1,noceanmx),tsea_ice(1),sea_ice(1)
-      real pctsrf_sic(1)
-
-
-
-!     added by AS to avoid the use of adv trac common
-      character*20,allocatable :: nametrac(:)   ! name of the tracer (no need for adv trac common)
-
-      real :: latitude, longitude
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-      !! those are defined in surfdat_h.F90
-      IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(1))
-      IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(1))
-      IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(1))
-      IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(1))
-      IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(1))
-      IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(1))
-      IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(1))
-      IF (.not. ALLOCATED(dryness)) ALLOCATE(dryness(1))
-      IF (.not. ALLOCATED(watercaptag)) ALLOCATE(watercaptag(1))
-      !! those are defined in comdiurn_h.F90
-      IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(1))
-      IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(1))
-      IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(1))
-      IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(1))
-      !! those are defined in comsoil_h.F90
-      IF (.not.ALLOCATED(layer)) ALLOCATE(layer(nsoilmx))
-      IF (.not.ALLOCATED(mlayer)) ALLOCATE(mlayer(0:nsoilmx-1))
-      IF (.not.ALLOCATED(inertiedat)) ALLOCATE(inertiedat(1,nsoilmx))
-      !! those are defined in comgeomfi_h
-      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(1))
-      IF (.not. ALLOCATED(long)) ALLOCATE(long(1))
-      IF (.not. ALLOCATED(area)) ALLOCATE(area(1))
-
-
-      saveprofile=.false.
-      saveprofile=.true.
-
-c ----------------------------------------
-c  Default values  (corresponding to Mars)
-c ----------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Parametres Couche limite et Turbulence 
-c     --------------------------------------
-      z0 =  1.e-2                ! surface roughness (m) ~0.01 
-      emin_turb = 1.e-6          ! energie minimale ~1.e-8
-      lmixmin = 30               ! longueur de melange ~100
- 
-c     propriete optiques des calottes et emissivite du sol
-c     ----------------------------------------------------
-      emissiv= 0.95              ! Emissivite du sol martien ~.95
-      emisice(1)=0.95            ! Emissivite calotte nord
-      emisice(2)=0.95            ! Emissivite calotte sud  
-
-      albedice(1)=0.5            ! Albedo calotte nord
-      albedice(2)=0.5            ! Albedo calotte sud
-      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
-      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
-      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
-      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
-      hybrid=.false.
-
-c ------------------------------------------------------
-c  Load parameters from "run.def" and "gases.def" 
-c ------------------------------------------------------
-
-! check if 'rcm1d.def' file is around 
-      open(90,file='rcm1d.def',status='old',form='formatted',
-     &     iostat=ierr)
-      if (ierr.ne.0) then
-        write(*,*) 'Cannot find required file "rcm1d.def"'
-        write(*,*) 'which should contain some input parameters'
-        write(*,*) ' ... might as well stop here ...'
-        stop
-      else
-        close(90)
-      endif
-
-! now, run.def is needed anyway. so we create a dummy temporary one
-! for ioipsl to work. if a run.def is already here, stop the
-! program and ask the user to do a bit of cleaning
-      open(90,file='run.def',status='old',form='formatted',
-     &     iostat=ierr)
-      if (ierr.eq.0) then
-        close(90)
-        write(*,*) 'There is already a run.def file.'
-        write(*,*) 'This is not compatible with 1D runs.'
-        write(*,*) 'Please remove the file and restart the run.'
-        write(*,*) 'Runtime parameters are supposed to be in rcm1d.def'
-        stop
-      else
-        call system('touch run.def')
-        call system("echo 'INCLUDEDEF=callphys.def' >> run.def")
-        call system("echo 'INCLUDEDEF=rcm1d.def' >> run.def")
-      endif
-
-! check if we are going to run with or without tracers
-      write(*,*) "Run with or without tracer transport ?"
-      tracer=.false. ! default value
-      call getin("tracer",tracer)
-      write(*,*) " tracer = ",tracer
-
-! OK. now that run.def has been read once -- any variable is in memory.
-! so we can dump the dummy run.def
-      call system("rm -rf run.def")
-
-! while we're at it, check if there is a 'traceur.def' file
-! and preocess it, if necessary. Otherwise initialize tracer names
-      if (tracer) then
-      ! load tracer names from file 'traceur.def'
-        open(90,file='traceur.def',status='old',form='formatted',
-     &       iostat=ierr)
-        if (ierr.eq.0) then
-          write(*,*) "rcm1d: Reading file traceur.def"
-          ! read number of tracers:
-          read(90,*,iostat=ierr) nq
-          nqtot=nq ! set value of nqtot (in infotrac module) as nq
-          if (ierr.ne.0) then
-            write(*,*) "rcm1d: error reading number of tracers"
-            write(*,*) "   (first line of traceur.def) "
-            stop
-          endif
-          if (nq>0) then
-            allocate(tname(nq))
-            allocate(q(llm,nq))
-            allocate(qsurf(nq))
-            allocate(dq(llm,nq))
-            allocate(dqdyn(llm,nq))
-          else
-            write(*,*) "rcm1d: Error. You set tracer=.true."
-            write(*,*) "       but # of tracers in traceur.def is ",nq
-            stop
-          endif
-        
-          do iq=1,nq
-          ! minimal version, just read in the tracer names, 1 per line
-            read(90,*,iostat=ierr) tname(iq)
-            if (ierr.ne.0) then
-              write(*,*) 'rcm1d: error reading tracer names...'
-              stop
-            endif
-          enddo !of do iq=1,nq
-! check for co2_ice / h2o_ice tracers:
-         i_co2_ice=0
-         i_h2o_ice=0
-         i_h2o_vap=0
-         do iq=1,nq
-           if (tname(iq)=="co2_ice") then
-             i_co2_ice=iq
-           elseif (tname(iq)=="h2o_ice") then
-             i_h2o_ice=iq
-           elseif (tname(iq)=="h2o_vap") then
-             i_h2o_vap=iq
-           endif
-         enddo
-        else
-          write(*,*) 'Cannot find required file "traceur.def"'
-          write(*,*) ' If you want to run with tracers, I need it'
-          write(*,*) ' ... might as well stop here ...'
-          stop
-        endif
-        close(90)
-
-      else ! of if (tracer)
-        nqtot=0
-        nq=0
-        ! still, make allocations for 1 dummy tracer
-        allocate(tname(1)) 
-        allocate(qsurf(1))
-        allocate(q(llm,1))
-        allocate(dq(llm,1))
-      
-       ! Check that tracer boolean is compliant with number of tracers
-       ! -- otherwise there is an error (and more generally we have to be consistent)
-       if (nq .ge. 1) then
-          write(*,*) "------------------------------"
-          write(*,*) "rcm1d: You set tracer=.false."
-          write(*,*) " But set number of tracers to ",nq
-          write(*,*) " > If you want tracers, set tracer=.true."
-          write(*,*) "------------------------------"
-          stop
-       endif
-      endif ! of if (tracer)
-
-!!! We have to check that check_cpp_match is F for 1D computations
-!!! We think this check is better than make a particular case for 1D in inifis or calc_cpp_mugaz
-      check_cpp_match = .false.
-      call getin("check_cpp_match",check_cpp_match)
-      if (check_cpp_match) then
-          print*,"In 1D modeling, check_cpp_match is supposed to be F"
-          print*,"Please correct callphys.def"
-          stop
-      endif
-
-!!! GEOGRAPHICAL INITIALIZATIONS
-     !!! AREA. useless in 1D
-      area(1)=1.E+0
-      aire(1)=area(1) !JL+EM to have access to the area in the diagfi.nc files. area in comgeomfi.h and aire in comgeom.h
-     !!! GEOPOTENTIAL. useless in 1D because control by surface pressure
-      phisfi(1)=0.E+0
-     !!! LATITUDE. can be set. 
-      latitude=0 ! default value for latitude
-      PRINT *,'latitude (in degrees) ?'
-      call getin("latitude",latitude)
-      write(*,*) " latitude = ",latitude
-      latitude=latitude*pi/180.E+0
-     !!! LONGITUDE. useless in 1D.
-      longitude=0.E+0
-      longitude=longitude*pi/180.E+0
-
-!!! CALL INIFIS
-!!! - read callphys.def
-!!! - calculate sine and cosine of longitude and latitude
-!!! - calculate mugaz and cp 
-!!! NB: some operations are being done dummily in inifis in 1D
-!!! - physical constants: nevermind, things are done allright below
-!!! - physical frequency: nevermind, in inifis this is a simple print
-      cpp=1.d-7 !JL because we divide by cpp in inifis, there may be a more elegant solution
-      CALL inifis(1,llm,nq,day0,daysec,dtphys,
-     .            latitude,longitude,area,rad,g,r,cpp)
-!!! We check everything is OK.
-      PRINT *,"CHECK"
-      PRINT *,"--> mugaz = ",mugaz
-      PRINT *,"--> cpp = ",cpp
-      r = 8.314511E+0 * 1000.E+0 / mugaz
-      rcp = r / cpp
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!! PLANETARY CONSTANTS !!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      g = -99999.
-      PRINT *,'GRAVITY in m s-2 ?'
-      call getin("g",g)
-      IF (g.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED g IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> g = ",g
-      ENDIF
-
-      rad = -99999.
-      PRINT *,'PLANETARY RADIUS in m ?'
-      call getin("rad",rad)
-      ! Planetary  radius is needed to compute shadow of the rings
-      IF (rad.eq.-99999. .and. rings_shadow .eqv. .true.) THEN
-          PRINT *,"STOP. I NEED rad IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> rad = ",rad
-      ENDIF
-
-      daysec = -99999.
-      PRINT *,'LENGTH OF A DAY in s ?'
-      call getin("daysec",daysec)
-      IF (daysec.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED daysec IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> daysec = ",daysec
-      ENDIF
-      omeg=4.*asin(1.)/(daysec)
-      PRINT *,"OK. FROM THIS I WORKED OUT:"
-      PRINT *,"--> omeg = ",omeg
-
-      year_day = -99999.
-      PRINT *,'LENGTH OF A YEAR in days ?'
-      call getin("year_day",year_day)
-      IF (year_day.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED year_day IN RCM1D.DEF."
-          STOP
-      ELSE 
-          PRINT *,"--> year_day = ",year_day
-      ENDIF
-
-      periastr = -99999.
-      PRINT *,'MIN DIST STAR-PLANET in AU ?'
-      call getin("periastr",periastr)
-      IF (periastr.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED periastr IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> periastr = ",periastr
-      ENDIF
-
-      apoastr = -99999.
-      PRINT *,'MAX DIST STAR-PLANET in AU ?'
-      call getin("apoastr",apoastr)
-      IF (apoastr.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED apoastr IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> apoastr = ",apoastr
-      ENDIF
-
-      peri_day = -99999.
-      PRINT *,'DATE OF PERIASTRON in days ?'
-      call getin("peri_day",peri_day)
-      IF (peri_day.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED peri_day IN RCM1D.DEF."
-          STOP
-      ELSE IF (peri_day.gt.year_day) THEN
-          PRINT *,"STOP. peri_day.gt.year_day"
-          STOP
-      ELSE  
-          PRINT *,"--> peri_day = ", peri_day
-      ENDIF 
-
-      obliquit = -99999. 
-      PRINT *,'OBLIQUITY in deg ?'
-      call getin("obliquit",obliquit)
-      IF (obliquit.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED obliquit IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> obliquit = ",obliquit
-      ENDIF 
-
-      psurf = -99999.
-      PRINT *,'SURFACE PRESSURE in Pa ?'
-      call getin("psurf",psurf)
-      IF (psurf.eq.-99999.) THEN
-          PRINT *,"STOP. I NEED psurf IN RCM1D.DEF."
-          STOP
-      ELSE
-          PRINT *,"--> psurf = ",psurf
-      ENDIF
-      !! we need reference pressures
-      pa=psurf/30.
-      preff=psurf ! these values are not needed in 1D  (are you sure JL12)
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!! END PLANETARY CONSTANTS !!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-c  Date et heure locale du debut du run
-c  ------------------------------------
-c    Date (en sols depuis le solstice de printemps) du debut du run
-      day0 = 0 ! default value for day0
-      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
-      call getin("day0",day0)
-      day=float(day0)
-      write(*,*) " day0 = ",day0
-c  Heure de demarrage
-      time=0 ! default value for time
-      write(*,*)'Initial local time (in hours, between 0 and 24)?'
-      call getin("time",time)
-      write(*,*)" time = ",time
-      time=time/24.E+0 ! convert time (hours) to fraction of sol
-
-
-c  Discretisation (Definition de la grille et des pas de temps)
-c  --------------
-c
-      nlayer=llm
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-
-      day_step=48 ! default value for day_step
-      PRINT *,'Number of time steps per sol ?'
-      call getin("day_step",day_step)
-      write(*,*) " day_step = ",day_step
-
-       
-      ecritphy=day_step ! default value for ecritphy
-      PRINT *,'Nunber of steps between writediagfi ?'
-      call getin("ecritphy",ecritphy)
-      write(*,*) " ecritphy = ",ecritphy
-
-      ndt=10 ! default value for ndt
-      PRINT *,'Number of sols to run ?'
-      call getin("ndt",ndt)
-      write(*,*) " ndt = ",ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-      write(*,*)"-------------------------------------"
-      write(*,*)"-------------------------------------"
-      write(*,*)"--> Physical timestep is ",dtphys
-      write(*,*)"-------------------------------------"
-      write(*,*)"-------------------------------------"
-
-c output spectrum?
-      write(*,*)"Output spectral OLR?"
-      specOLR=.false.
-      call getin("specOLR",specOLR)
-      write(*,*)" specOLR = ",specOLR
-
-c
-c  pour le schema d'ondes de gravite
-c  ---------------------------------
-      zmea(1)=0.E+0
-      zstd(1)=0.E+0
-      zsig(1)=0.E+0
-      zgam(1)=0.E+0
-      zthe(1)=0.E+0
-
-c    Initialisation des traceurs
-c    ---------------------------
-
-      DO iq=1,nq
-        DO ilayer=1,nlayer
-           q(ilayer,iq) = 0.
-        ENDDO
-      ENDDO
-     
-      DO iq=1,nq
-        qsurf(iq) = 0.
-      ENDDO
-
-      if (water) then
-         qzero1D               = 0.0
-         qsurf(i_h2o_vap) = qzero1D
-      endif
-
-c   Initialisation pour prendre en compte les vents en 1-D
-c   ------------------------------------------------------
-      ptif=2.E+0*omeg*sinlat(1)
- 
-
-c    vent geostrophique
-      gru=10. ! default value for gru
-      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
-      call getin("u",gru)
-      write(*,*) " u = ",gru
-      grv=0. !default value for grv
-      PRINT *,'meridional northward component of the geostrophic',
-     &' wind (m/s) ?'
-      call getin("v",grv)
-      write(*,*) " v = ",grv
-
-c     Initialisation des vents  au premier pas de temps
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c     energie cinetique turbulente
-      DO ilevel=1,nlevel
-         q2(ilevel)=0.E+0
-      ENDDO
-
-c  emissivity / surface co2 ice ( + h2o ice??)
-c  -------------------------------------------
-      emis(1)=emissiv ! default value for emissivity
-      PRINT *,'Emissivity of bare ground ?'
-      call getin("emis",emis(1))
-      write(*,*) " emis = ",emis(1)
-      emissiv=emis(1) ! we do this so that condense_co2 sets things to the right
-                   ! value if there is no snow
-
-      if(i_co2_ice.gt.0)then
-         qsurf(i_co2_ice)=0 ! default value for co2ice
-         print*,'Initial CO2 ice on the surface (kg.m-2)'
-         call getin("co2ice",qsurf(i_co2_ice))
-         write(*,*) " co2ice = ",qsurf(i_co2_ice)
-         IF (qsurf(i_co2_ice).ge.1.E+0) THEN
-            ! if we have some CO2 ice on the surface, change emissivity
-            if (lati(1).ge.0) then ! northern hemisphere
-              emis(1)=emisice(1)
-            else ! southern hemisphere
-              emis(1)=emisice(2)
-            endif
-         ENDIF
-      endif
-
-c  calcul des pressions et altitudes en utilisant les niveaux sigma
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates
-c    """"""""""""""""""""
-      hybrid=.true.
-      PRINT *,'Hybrid coordinates ?'
-      call getin("hybrid",hybrid)
-      write(*,*) " hybrid = ", hybrid
-
-
-      autozlevs=.false.
-      PRINT *,'Auto-discretise vertical levels ?'
-      call getin("autozlevs",autozlevs)
-      write(*,*) " autozlevs = ", autozlevs
-
-      pceil = psurf / 1000.0 ! Pascals
-      PRINT *,'Ceiling pressure (Pa) ?'
-      call getin("pceil",pceil)
-      write(*,*) " pceil = ", pceil
-
-! Test of incompatibility:
-! if autozlevs used, cannot have hybrid too
-
-      if (autozlevs.and.hybrid) then
-         print*,'Cannot use autozlevs and hybrid together!'
-         call abort
-      endif
-
-      if(autozlevs)then
-            
-         open(91,file="z2sig.def",form='formatted')
-         read(91,*) Hscale
-         DO ilayer=1,nlayer-2
-            read(91,*) Hmax
-         enddo
-         close(91)
- 
-            
-         print*,'Hmax = ',Hmax,' km'
-         print*,'Auto-shifting Hscale to:'
-!     Hscale = Hmax / log(psurf/100.0)
-         Hscale = Hmax / log(psurf/pceil)
-         print*,'Hscale = ',Hscale,' km'
-         
-! none of this matters if we dont care about zlay
-         
-      endif
-
-      call disvert
-
-         if(.not.autozlevs)then
-            ! we want only the scale height from z2sig, in order to compute zlay
-            open(91,file="z2sig.def",form='formatted')
-            read(91,*) Hscale
-            close(91)
-         endif
-
-!         if(autozlevs)then
-!            open(94,file="Hscale.temp",form='formatted')
-!            read(94,*) Hscale
-!            close(94)
-!         endif
-
-         DO ilevel=1,nlevel
-            plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-         ENDDO
-         
-         DO ilayer=1,nlayer
-            play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-         ENDDO
-         
-
-
-         DO ilayer=1,nlayer
-!     zlay(ilayer)=-300.E+0 *r*log(play(ilayer)/plev(1))
-!     &   /g
-            zlay(ilayer)=-1000.0*Hscale*log(play(ilayer)/plev(1))
-         ENDDO
-
-!      endif
-
-c  profil de temperature au premier appel
-c  --------------------------------------
-      pks=psurf**rcp
-
-c altitude en km dans profile: on divise zlay par 1000
-      tmp1(0)=0.E+0
-      DO ilayer=1,nlayer
-        tmp1(ilayer)=zlay(ilayer)/1000.E+0
-      ENDDO
-      call profile(nlayer+1,tmp1,tmp2)
-
-      tsurf(1)=tmp2(0)
-      DO ilayer=1,nlayer
-        temp(ilayer)=tmp2(ilayer)
-      ENDDO
-      print*,"check"
-      PRINT*,"INPUT SURFACE TEMPERATURE",tsurf(1)
-      PRINT*,"INPUT TEMPERATURE PROFILE",temp
-
-c  Initialisation albedo / inertie du sol
-c  --------------------------------------
-      albedodat(1)=0.2 ! default value for albedodat
-      PRINT *,'Albedo of bare ground ?'
-      call getin("albedo",albedodat(1))
-      write(*,*) " albedo = ",albedodat(1)
-
-      inertiedat(1,1)=400 ! default value for inertiedat
-      PRINT *,'Soil thermal inertia (SI) ?'
-      call getin("inertia",inertiedat(1,1))
-      write(*,*) " inertia = ",inertiedat(1,1)
-
-! Initialize soil properties and temperature
-! ------------------------------------------
-      volcapa=1.e6 ! volumetric heat capacity
-      DO isoil=1,nsoil
-         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
-         tsoil(isoil)=tsurf(1)  ! soil temperature
-      ENDDO
-
-! Initialize depths
-! -----------------
-      do isoil=0,nsoil-1
-        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
-      enddo
-      do isoil=1,nsoil
-        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
-      enddo
-
-
-! Initialize slab ocean
-! -----------------
-      rnat=1. ! default value for rnat
-      if(inertiedat(1,1).GE.10000.)then
-         rnat=0.
-      endif
-      if(ok_slab_ocean)then
-      rnat=0.
-      tslab(1,1)=tsurf(1)
-      tslab(1,2)=tsurf(1)
-      tsea_ice=tsurf
-      pctsrf_sic=0.
-      sea_ice=0.
-      endif
-
-
-
-c  Write a "startfi" file
-c  --------------------
-c  This file will be read during the first call to "physiq".
-c  It is needed to transfert physics variables to "physiq"...
-
-      call physdem0("startfi.nc",long,lati,nsoilmx,1,llm,nq,
-     &              dtphys,real(day0),time,area,
-     &              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("startfi.nc",nsoilmx,1,llm,nq,
-     &                dtphys,time,
-     &                tsurf,tsoil,emis,q2,qsurf,
-     &                cloudfrac,totcloudfrac,hice, 
-     &                rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
-
-!      call physdem1(1,"startfi.nc",long,lati,nsoilmx,nq,
-!     &              dtphys,float(day0),
-!     &              time,tsurf,tsoil,emis,q2,qsurf,
-!     &              area,albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe,
-!     &              cloudfrac,totcloudfrac,hice,nametrac)
-
-c=======================================================================
-c  BOUCLE TEMPORELLE DU MODELE 1D 
-c=======================================================================
-
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-        IF (idt.eq.ndt) then       !test
-         lastcall=.true.
-         call stellarlong(day*1.0,zls)
-!         write(103,*) 'Ls=',zls*180./pi
-!         write(103,*) 'Lat=', lati(1)*180./pi
-!         write(103,*) 'RunEnd - Atmos. Temp. File'
-!         write(103,*) 'RunEnd - Atmos. Temp. File'
-!         write(104,*) 'Ls=',zls*180./pi
-!         write(104,*) 'Lat=', lati(1)
-!         write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c    calcul du geopotentiel 
-c     ~~~~~~~~~~~~~~~~~~~~~
-
-
-      DO ilayer=1,nlayer
-
-!              if(autozlevs)then
-!                 s(ilayer)=(play(ilayer)/psurf)**rcp
-!              else
-          s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-!              endif
-              !s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-          h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
-       ENDDO
-
-!      DO ilayer=1,nlayer
-!        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-!        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
-!      ENDDO
-      phi(1)=pks*h(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
-     &                  *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       appel de la physique
-c       --------------------
-
-
-      CALL physiq (1,llm,nq,
-     .     tname,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,phi,
-     ,     u, v,temp, q,  
-     ,     w,
-C - sorties
-     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
-
-
-c       evolution du vent : modele 1D
-c       -----------------------------
- 
-c       la physique calcule les derivees temporelles de u et v.
-c       on y rajoute betement un effet Coriolis.
-c
-c       DO ilayer=1,nlayer
-c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
-c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
-c       ENDDO
-
-c       Pour certain test : pas de coriolis a l'equateur
-c       if(lati(1).eq.0.) then
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c       end if
-c      
-c
-c       Calcul du temps au pas de temps suivant
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       calcul des vitesses et temperature au pas de temps suivant
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       calcul des pressions au pas de temps suivant
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
-           DO ilevel=1,nlevel
-              plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-                 play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-c       calcul traceur au pas de temps suivant
-c       --------------------------------------
-
-        DO iq = 1, nq
-          DO ilayer=1,nlayer
-             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
-          ENDDO
-        END DO
-
-c    ========================================================
-c    GESTION DES SORTIE
-c    ========================================================
-      if(saveprofile)then
-         OPEN(12,file='profile.out',form='formatted')
-         write(12,*) tsurf
-         DO ilayer=1,llm
-            write(12,*) temp(ilayer) !, play(ilayer) !AS12 only temp so that iprofile=8 can be used
-         ENDDO
-         CLOSE(12)
-      endif
-
-
-      ENDDO   ! fin de la boucle temporelle
-
-      write(*,*) "rcm1d: Everything is cool."
-
-c    ========================================================
-      end                       !rcm1d
- 
-c***********************************************************************
-c***********************************************************************
-c     Subroutines Bidons utilise seulement en 3D, mais
-c     necessaire a la compilation de rcm1d en 1D
-
-      subroutine gr_fi_dyn
-      RETURN
-      END
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d/disvert.F"
-#include "../dyn3d/abort_gcm.F"
-#include "../dyn3d/diverg.F"
-#include "../dyn3d/grad.F"
-#include "../dyn3d/gr_u_scal.F"
-#include "../dyn3d/gr_v_scal.F"
-#include "../dyn3d/gr_dyn_fi.F"
-
Index: unk/LMDZ.GENERIC/libf/phystd/start2archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/start2archive.F	(revision 1402)
+++ 	(revision )
@@ -1,519 +1,0 @@
-c=======================================================================
-      PROGRAM start2archive
-c=======================================================================
-c
-c
-c   Date:    01/1997
-c   ----
-c
-c
-c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
-c   -----    "startfi" a un fichier netcdf unique "start_archive" 
-c
-c  "start_archive" est une banque d'etats initiaux:
-c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
-c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
-c 
-c
-c
-c=======================================================================
-
-      use infotrac, only: iniadvtrac, nqtot, tname
-      USE comsoil_h
-      USE comgeomfi_h, ONLY: lati, long, area
-!      use control_mod
-      use comgeomphy, only: initcomgeomphy
-      use slab_ice_h, only: noceanmx
-! to use  'getin'
-      USE ioipsl_getincom
-      USE planete_mod, only: year_day
-      USE callkeys_mod, ONLY: ok_slab_ocean
-
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "temps.h"
-!#include "control.h"
-#include "ener.h"
-
-!#include "dimphys.h"
-!#include "planete.h"
-!#include"advtrac.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 :: q(:,:,:)   ! champs advectes
-      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
-      REAL pk(ip1jmp1,llm)
-      REAL pkf(ip1jmp1,llm)
-      REAL 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 ------------------------------------
-      REAL tsurf(ngridmx)	! Surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
-      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL q2(ngridmx,llm+1)
-      REAL,ALLOCATABLE :: qsurf(:,:)
-      REAL emis(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
-
-!     added by FF for cloud fraction setup
-      REAL hice(ngridmx)
-      REAL cloudfrac(ngridmx,llm),totalcloudfrac(ngridmx)
-
-!     added by BC for slab ocean
-      REAL rnat(ngridmx),pctsrf_sic(ngridmx),sea_ice(ngridmx)
-      REAL tslab(ngridmx,noceanmx),tsea_ice(ngridmx)
-
-
-c Variable naturelle / grille scalaire
-c ------------------------------------
-      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
-      REAL tsurfS(ip1jmp1)
-      REAL tsoilS(ip1jmp1,nsoilmx)
-      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
-      REAL co2iceS(ip1jmp1)
-      REAL q2S(ip1jmp1,llm+1)
-      REAL,ALLOCATABLE :: qsurfS(:,:)
-      REAL emisS(ip1jmp1)
-
-!     added by FF for cloud fraction setup
-      REAL hiceS(ip1jmp1)
-      REAL cloudfracS(ip1jmp1,llm),totalcloudfracS(ip1jmp1)
-
-!     added by BC for slab ocean
-      REAL rnatS(ip1jmp1),pctsrf_sicS(ip1jmp1),sea_iceS(ip1jmp1)
-      REAL tslabS(ip1jmp1,noceanmx),tsea_iceS(ip1jmp1)
-
-
-c Variables intermediaires : vent naturel, mais pas coord scalaire
-c----------------------------------------------------------------
-      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
-
-c Autres  variables
-c -----------------
-      LOGICAL startdrs
-      INTEGER Lmodif
-
-      REAL ptotal, co2icetotal
-      REAL timedyn,timefi !fraction du jour dans start, startfi
-      REAL date
-
-      CHARACTER*2 str2
-      CHARACTER*80 fichier 
-      data  fichier /'startfi'/
-
-      INTEGER ij, l,i,j,isoil,iq
-      character*80      fichnom
-      integer :: ierr,ntime
-      integer :: nq,numvanle
-      character(len=30) :: txt ! to store some text
-
-c Netcdf
-c-------
-      integer varid,dimid,timelen 
-      INTEGER nid,nid1
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .TRUE. )
-      grireg   = .TRUE.
-
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-      ! ALLOCATE ARRAYS IN comgeomfi_h (usually done in inifis)
-      ! this must be here for start2archive to work
-      IF (.not. ALLOCATED(lati)) ALLOCATE(lati(ngridmx))
-      IF (.not. ALLOCATED(long)) ALLOCATE(long(ngridmx))
-      IF (.not. ALLOCATED(area)) ALLOCATE(area(ngridmx))
-
-c=======================================================================
-c Lecture des donnees
-c=======================================================================
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-
-! allocate arrays:
-      allocate(q(ip1jmp1,llm,nqtot))
-      allocate(qsurf(ngridmx,nqtot))
-      allocate(qsurfS(ip1jmp1,nqtot))
-! other array allocations:
-      call ini_comsoil_h(ngridmx)
-
-      fichnom = 'start.nc'
-      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,timedyn)
-
-! load 'controle' array from dynamics start file
-
-       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
-       IF (ierr.NE.NF_NOERR) THEN
-         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
-        CALL ABORT
-       ENDIF
-                                                
-      ierr = NF_INQ_VARID (nid1, "controle", varid)
-      IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "start2archive: Le champ <controle> est absent"
-       CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_dyn)
-#else
-      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_dyn)
-#endif
-       IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "start2archive: Lecture echoue pour <controle>"
-          CALL abort
-       ENDIF
-
-      ierr = NF_CLOSE(nid1)
-      
-
-      fichnom = 'startfi.nc'
-      Lmodif=0
-
-
-      CALL phyetat0 (ngridmx,llm,fichnom,0,Lmodif,nsoilmx,nqtot,
-     .      day_ini_fi,timefi,
-     .      tsurf,tsoil,emis,q2,qsurf,
-!       change FF 05/2011
-     .       cloudfrac,totalcloudfrac,hice,
-!       change BC 05/2014
-     .       rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
-
-
-
-
-! load 'controle' array from physics start file
-
-       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
-       IF (ierr.NE.NF_NOERR) THEN
-         write(6,*)' Pb d''ouverture du fichier'//trim(fichnom)
-        CALL ABORT
-       ENDIF
-                                                
-      ierr = NF_INQ_VARID (nid1, "controle", varid)
-      IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "start2archive: Le champ <controle> est absent"
-       CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
-#else
-      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
-#endif
-       IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "start2archive: Lecture echoue pour <controle>"
-          CALL abort
-       ENDIF
-
-      ierr = NF_CLOSE(nid1)
-
-
-c-----------------------------------------------------------------------
-c Controle de la synchro
-c-----------------------------------------------------------------------
-!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
-      if ((day_ini_fi.ne.day_ini)) 
-     &  stop ' Probleme de Synchro entre start et startfi !!!'
-
-
-c *****************************************************************
-c    Option : Reinitialisation des dates dans la premieres annees :
-       do while (day_ini.ge.year_day)
-          day_ini=day_ini-year_day
-       enddo
-c *****************************************************************
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .FALSE. )
-      call iniconst
-      call inigeom
-      call inifilr
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-
-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-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO ij=1,ip1jmp1
-            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c Variable physique 
-c-----------------------------------------------------------------------
-c
-c tsurf --> tsurfS
-c co2ice --> co2iceS
-c tsoil --> tsoilS
-c emis --> emisS
-c q2 --> q2S
-c qsurf --> qsurfS
-c
-c-----------------------------------------------------------------------
-
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
-!      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
-      ! Note: thermal inertia "inertiedat" is in comsoil.h
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
-      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
-      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
-      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,cloudfrac,cloudfracS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,hice,hiceS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,totalcloudfrac,totalcloudfracS)
-
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rnat,rnatS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,pctsrf_sic,pctsrf_sicS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsea_ice,tsea_iceS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sea_ice,sea_iceS)
-      call gr_fi_dyn(noceanmx,ngridmx,iip1,jjp1,tslab,tslabS)
-
-c=======================================================================
-c Info pour controler
-c=======================================================================
-
-      ptotal =  0.
-      co2icetotal = 0.
-      DO j=1,jjp1
-         DO i=1,iim
-           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
-!           co2icetotal = co2icetotal + 
-!     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
-         ENDDO
-      ENDDO
-      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
-!      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
-
-c-----------------------------------------------------------------------
-c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
-c-----------------------------------------------------------------------
-
-      tab_cntrl_fi(49) = ptotal
-      tab_cntrl_fi(50) = co2icetotal
-
-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 dynamique (1 a 16) 
-c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
-c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
-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,day_ini,phis,ithS,tab_cntrl_fi,
-     &                                          tab_cntrl_dyn)
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture de la coordonnee temps (date en jours)
-c-----------------------------------------------------------------------
-
-      date = day_ini
-      ierr= NF_INQ_VARID(nid,"Time",varid)
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-      ntime=timelen+1
-
-      write(*,*) "******************"
-      write(*,*) "ntime",ntime
-      write(*,*) "******************"
-#ifdef NC_DOUBLE
-      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
-#else
-      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
-#endif
-      if (ierr.ne.NF_NOERR) then
-         write(*,*) "time matter ",NF_STRERROR(ierr)
-         stop
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
-c-----------------------------------------------------------------------
-c ATTENTION: q2 a une couche de plus!!!!
-c    Pour creer un fichier netcdf lisible par grads,
-c    On passe donc une des couches de q2 a part
-c    comme une variable 2D (la couche au sol: "q2surf")
-c    Les lmm autres couches sont nommees "q2atm" (3D) 
-c-----------------------------------------------------------------------
-
-!      call write_archive(nid,ntime,'co2ice','couche de glace co2',
-!     &  'kg/m2',2,co2iceS)
-      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
-      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
-      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
-      call write_archive(nid,ntime,'temp','temperature','K',3,t)
-      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
-      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
-      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
-     .              q2S)
-      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
-     .              q2S(1,2))
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  q  ( q[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
-     &         3,q(1,1,iq))
-      end do
-c-----------------------------------------------------------------------
-c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-        txt=trim(tname(iq))//"_surf"
-        call write_archive(nid,ntime,txt,'Tracer on surface',
-     &  'kg.m-2',2,qsurfS(1,iq))
-      enddo
-
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  tsoil  ( Tg[1,10] )
-c-----------------------------------------------------------------------
-c "tsoil" Temperature au sol definie dans 10 couches dans le sol
-c   Les 10 couches sont lues comme 10 champs 
-c  nommees Tg[1,10]
-
-c      do isoil=1,nsoilmx
-c       write(str2,'(i2.2)') isoil
-c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
-c     .   'K',2,tsoilS(1,isoil))
-c      enddo
-
-! Write soil temperatures tsoil
-      call write_archive(nid,ntime,'tsoil','Soil temperature',
-     &     'K',-3,tsoilS)
-
-! Write soil thermal inertia
-      call write_archive(nid,ntime,'inertiedat',
-     &     'Soil thermal inertia',
-     &     'J.s-1/2.m-2.K-1',-3,ithS)
-
-! Write (0D) volumetric heat capacity (stored in comsoil.h)
-!      call write_archive(nid,ntime,'volcapa',
-!     &     'Soil volumetric heat capacity',
-!     &     'J.m-3.K-1',0,volcapa)
-! Note: no need to write volcapa, it is stored in "controle" table
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  cloudfrac,hice,totalcloudfrac
-c-----------------------------------------------------------------------
-      call write_archive(nid,ntime,'hice',
-     &         'Height of oceanic ice','m',2,hiceS)
-      call write_archive(nid,ntime,'totalcloudfrac',
-     &        'Total cloud Fraction','',2,totalcloudfracS)
-      call write_archive(nid,ntime,'cloudfrac'
-     &        ,'Cloud fraction','',3,cloudfracS)
-
-c-----------------------------------------------------------------------
-c Slab ocean
-c-----------------------------------------------------------------------
-      OPEN(99,file='callphys.def',status='old',form='formatted'
-     &     ,iostat=ierr)
-      CLOSE(99)
-
-      IF(ierr.EQ.0) THEN
-
-
-         write(*,*) "Use slab-ocean ?"
-         ok_slab_ocean=.false.         ! default value
-         call getin("ok_slab_ocean",ok_slab_ocean)
-         write(*,*) "ok_slab_ocean = ",ok_slab_ocean
-
-      if(ok_slab_ocean) then
-      call write_archive(nid,ntime,'rnat'
-     &        ,'rnat','',2,rnatS)
-      call write_archive(nid,ntime,'pctsrf_sic'
-     &        ,'pctsrf_sic','',2,pctsrf_sicS)
-      call write_archive(nid,ntime,'sea_ice'
-     &        ,'sea_ice','',2,sea_iceS)
-      call write_archive(nid,ntime,'tslab'
-     &        ,'tslab','',3,tslabS)
-      call write_archive(nid,ntime,'tsea_ice'
-     &        ,'tsea_ice','',2,tsea_iceS)
-      endif !ok_slab_ocean
-      ENDIF
-c-----------------------------------------------------------------------
-c Fin 
-c-----------------------------------------------------------------------
-      ierr=NF_CLOSE(nid)
-
-      write(*,*) "start2archive: All is well that ends well."
-
-      end 
Index: unk/LMDZ.GENERIC/libf/phystd/write_archive.F
===================================================================
--- /trunk/LMDZ.GENERIC/libf/phystd/write_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,250 +1,0 @@
-c=======================================================================
-      subroutine write_archive(nid,ntime,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 comsoil_h, only: nsoilmx
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c	Declarations   
-c-----------------------------------------------------------------------
-
-c Arguments:
-
-      INTEGER nid
-      integer ntime ! time index
-      integer 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
-c-----------------------------------------------------------------------
-c      Ecriture du champs dans le fichier            (3 cas)      
-c-----------------------------------------------------------------------
-
-! For an atmospheric 3D Variable
-!--------------------------------
-        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,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
-              ierr= NF_INQ_DIMID(nid,"altitude",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
-
-! mars s'arranger pour qu'il n'y ai plus besoin de ca
-
-c          do l=1,llm
-c             do j=1,jjp1
-c                do i=1,iip1
-c                   pxbis(i,j,l)=px(i,j,llm-l+1)
-c                enddo
-c             enddo
-c          enddo
-           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
-
-
-! For a subterranean 3D Variable
-!-------------------------------
-
-        else if (dim.eq.-3) then
-	! get variables' ID, if it exists
-	ierr=NF_INQ_VARID(nid,nom,varid)
-	
-	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
-	  ! build related coordinates
-	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
-	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
-	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
-	  if (ierr.ne.NF_NOERR) then
-	   write(*,*)"write_archive: dimension <subsurface_layers>",
-     &               " is missing !!!"
-	   call abort
-	  endif
-          ierr=NF_INQ_DIMID(nid,"Time",id(4))
-	  
-	  ! define the variable
-	  write(*,*)"====================="
-	  write(*,*)"defining ",nom
-	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
-	  
-	 endif
-
-        ! build cedges and corners
-        corner(1)=1
-        corner(2)=1
-        corner(3)=1
-        corner(4)=ntime
-
-        edges(1)=iip1
-        edges(2)=jjp1
-        edges(3)=nsoilmx
-        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
-
-
-! For a surface 2D Variable
-!--------------------------
-
-        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,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",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,"Time",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
-
-        else
-	  write(*,*) "write_archive: dim=",dim," ?!?"
-	  call abort
-        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
-
-      return
-      end
-
Index: /trunk/LMDZ.GENERIC/makegcm_g95
===================================================================
--- /trunk/LMDZ.GENERIC/makegcm_g95	(revision 1402)
+++ /trunk/LMDZ.GENERIC/makegcm_g95	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=std
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I.'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -16,4 +16,7 @@
 set scatterers="1"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -25,15 +28,13 @@
 set scriptdir=`dirname $0`
 setenv LMDGCM `readlink -f $scriptdir`
-#setenv LMDGCM /u/emlmd/LMDZ.MARS
+#setenv LMDGCM "/san/home/rdword/gcm/LMDZ.GENERIC"
 setenv LIBOGCM $LMDGCM/libo
-# NetCDF
-# 64 bit machines what is below is OK on LMD machines
-  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
-  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
-#else
-#  setenv NCDFLIB /distrib/local/netcdf/g95_32bits/lib
-#  setenv NCDFINC /distrib/local/netcdf/g95_32bits/include
-#endif
-####
+# NetCDF, on LMD computers:
+setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
+setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
+#####
+
+
+
 
 setenv localdir "`pwd`"
@@ -120,4 +121,7 @@
    set machine=XNEC
    set XNEC=1
+else if ( `uname` == CYGWIN_NT-6.1-WOW64) then
+   set machine=LINUX
+   set LINUX=1
 else
    echo Vous travaillez sur une machine non prevue par le reglement
@@ -209,5 +213,4 @@
      set mod_loc_dir="./"
    else
-####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set mod_loc_dir="."
@@ -326,9 +329,9 @@
 ########################################################################
 
-    case -d:
+    case -d
         set dim=$2 ; shift ; shift ; goto top
                         
     case -O:
-        set optim90="$2" ; shift ; shift ; goto top
+        set optim90="$2" ; set optim="$2" ; set optimtru90="$2" ; shift ; shift ; goto top
 
      case -p
@@ -391,4 +394,5 @@
 endif
 
+
 echo "apres les opts dim $dim"
 
@@ -398,9 +402,14 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs phy$physique"
+   set include="$include "' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 #subtilites sur le nom de la librairie
 ########################################################################
+
 
 \rm tmp ; touch tmp
@@ -476,10 +485,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -554,5 +568,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -576,6 +595,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -618,12 +642,9 @@
         \cp tmp77 liste_des_sources_f77
         \cp tmp90 liste_des_sources_f90
-        echo "On recree le makefile"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
-        endif
+        echo "Remaking the makefile!"
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
-        echo "Nouveau makefile cree."
+        echo "New makefile created."
 endif
 
@@ -631,4 +652,5 @@
 #  Execution de la comande make
 ########################################################################
+
 
 echo PHYSIQUE $phys
@@ -649,6 +671,4 @@
    set f90=f90
 else if $LINUX then
-#   set f77=pgf90
-#   set f90=pgf90
    set f77=g95
    set f90=g95
@@ -727,14 +747,28 @@
 set source_code=${code}.F
 # handle cases when the main program is in the physics directory
-if (-f $LMDGCM/libf/phy${physique}/${code}.F) then
-  set dyn="$dyn DIRMAIN=phy$physique "
-endif
-if (-f $LMDGCM/libf/phy${physique}/${code}.F90) then
+set dirmain=dyn${dimc}d
+if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
-  set dyn="$dyn DIRMAIN=phy$physique "
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F90
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
 echo $make -f $LMDGCM/makefile \
 OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
 OPTIM90="$optim90" \
 OPTIMTRU90="$optimtru90" \
@@ -742,8 +776,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -756,4 +791,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -762,4 +798,5 @@
 $make -f $LMDGCM/makefile \
 OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
+OPTIM="$optim" \
 OPTIM90="$optim90" \
 OPTIMTRU90="$optimtru90" \
@@ -767,8 +804,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -781,4 +819,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -786,4 +825,4 @@
 \rm -f $libf/grid/dimensions.h
 \rm -f $libf/grid/bands.h
-\rm -f $libf/phy${physique}/bands.h
+\rm -f $libf/phy$physique/bands.h
 \rm -f $libf/phy$physique/scatterers.h
Index: /trunk/LMDZ.GENERIC/makegcm_gfortran
===================================================================
--- /trunk/LMDZ.GENERIC/makegcm_gfortran	(revision 1402)
+++ /trunk/LMDZ.GENERIC/makegcm_gfortran	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=std
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I.'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -16,4 +16,7 @@
 set scatterers="1"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -405,6 +408,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs phy$physique"
+   set include="$include "' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 #subtilites sur le nom de la librairie
@@ -484,10 +491,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -562,5 +574,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -584,6 +601,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -627,9 +649,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "Remaking the makefile!"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "New makefile created."
@@ -744,10 +763,23 @@
 set source_code=${code}.F
 # handle cases when the main program is in the physics directory
-if (-f $LMDGCM/libf/phy${physique}/${code}.F) then
-  set dyn="$dyn DIRMAIN=phy$physique "
-endif
-if (-f $LMDGCM/libf/phy${physique}/${code}.F90) then
+set dirmain=dyn${dimc}d
+if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
-  set dyn="$dyn DIRMAIN=phy$physique "
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F90
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -760,8 +792,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -774,4 +807,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -786,8 +820,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -800,4 +835,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
Index: /trunk/LMDZ.GENERIC/makegcm_ifort
===================================================================
--- /trunk/LMDZ.GENERIC/makegcm_ifort	(revision 1402)
+++ /trunk/LMDZ.GENERIC/makegcm_ifort	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=std
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I.'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -16,4 +16,7 @@
 set scatterers="1"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -126,4 +129,7 @@
    set machine=XNEC
    set XNEC=1
+else if ( `uname` == CYGWIN_NT-6.1-WOW64) then
+   set machine=LINUX
+   set LINUX=1
 else
    echo Vous travaillez sur une machine non prevue par le reglement
@@ -216,5 +222,4 @@
      set mod_loc_dir="./"
    else
-####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set mod_loc_dir="."
@@ -224,5 +229,5 @@
 endif
 
-set nomlib=$machine
+set nomlib=${machine}
 
 # Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
@@ -404,6 +409,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs phy$physique"
+   set include="$include "' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 #subtilites sur le nom de la librairie
@@ -483,10 +492,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -561,5 +575,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -583,6 +602,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
-else
-   set filtre="FILTRE= L_FILTRE= "
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
+else
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -626,9 +650,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "Remaking the makefile!"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "New makefile created."
@@ -663,6 +684,4 @@
 #   set f90="ifort -real-size 64 -DNC_DOUBLE"
    set opt_link=" -L$LIBOGCM -L$NCDFLIB -lnetcdf "
-#   set f77=pgf90
-#   set f90=pgf90
 else if $SUN then
    set f77=f90
@@ -739,10 +758,23 @@
 set source_code=${code}.F
 # handle cases when the main program is in the physics directory
-if (-f $LMDGCM/libf/phy${physique}/${code}.F) then
-  set dyn="$dyn DIRMAIN=phy$physique "
-endif
-if (-f $LMDGCM/libf/phy${physique}/${code}.F90) then
+set dirmain=dyn${dimc}d
+if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
-  set dyn="$dyn DIRMAIN=phy$physique "
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F90
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -755,8 +787,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -769,6 +802,8 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
+
 
 $make -f $LMDGCM/makefile \
@@ -780,8 +815,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -794,4 +830,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -799,4 +836,4 @@
 \rm -f $libf/grid/dimensions.h
 \rm -f $libf/grid/bands.h
-\rm -f $libf/phy${physique}/bands.h
+\rm -f $libf/phy$physique/bands.h
 \rm -f $libf/phy$physique/scatterers.h
Index: /trunk/LMDZ.GENERIC/makegcm_pgf90
===================================================================
--- /trunk/LMDZ.GENERIC/makegcm_pgf90	(revision 1402)
+++ /trunk/LMDZ.GENERIC/makegcm_pgf90	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=std
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I.'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -16,4 +16,7 @@
 set scatterers="1"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -27,5 +30,5 @@
 #setenv LMDGCM "/san/home/rdword/gcm/LMDZ.GENERIC"
 setenv LIBOGCM $LMDGCM/libo
-# NetCDF, on LMD 64 bit machines
+# NetCDF, on LMD computers:
 setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_pgi/lib
 setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_pgi/include
@@ -115,4 +118,7 @@
    set machine=XNEC
    set XNEC=1
+else if ( `uname` == CYGWIN_NT-6.1-WOW64) then
+   set machine=LINUX
+   set LINUX=1
 else
    echo Vous travaillez sur une machine non prevue par le reglement
@@ -208,5 +214,4 @@
      set mod_loc_dir="./"
    else
-####     set opt_link=" -C hopt -float0 -ew -P static -L$IOIPSLDIR -lsxioipsl -L /u/rech/psl/rpsl003/IOIPSL -lnetcdf_i8r8_v -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set opt_link=" -C hopt -float0 -ew -P static -I$NCDFINC -L/SX/usr/local/lib -lnetcdf_i8r8"
      set mod_loc_dir="."
@@ -216,5 +221,5 @@
 endif
 
-set nomlib=$machine
+set nomlib=${machine}
 
 # Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
@@ -399,6 +404,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs phy$physique"
+   set include="$include "' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 #subtilites sur le nom de la librairie
@@ -478,10 +487,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -556,5 +570,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -578,6 +597,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -621,9 +645,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "Remaking the makefile!"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "New makefile created."
@@ -730,15 +751,27 @@
 endif
 
-
 cd $localdir
 
 set source_code=${code}.F
 # handle cases when the main program is in the physics directory
-if (-f $LMDGCM/libf/phy${physique}/${code}.F) then
-  set dyn="$dyn DIRMAIN=phy$physique "
-endif
-if (-f $LMDGCM/libf/phy${physique}/${code}.F90) then
+set dirmain=dyn${dimc}d
+if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
-  set dyn="$dyn DIRMAIN=phy$physique "
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
+  set source_code=${code}.F90
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -751,8 +784,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -765,4 +799,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -777,8 +812,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -791,4 +827,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
Index: /trunk/LMDZ.MARS/README
===================================================================
--- /trunk/LMDZ.MARS/README	(revision 1402)
+++ /trunk/LMDZ.MARS/README	(revision 1403)
@@ -2168,2 +2168,17 @@
 - Follow-up to cleanup in dynamics/physics interface. Add iniprint.h to be
   in line with what is done in LMDZ.COMMON dynamics.
+
+== 31/03/2015 == EM
+- Reorganizing the physics/dynamics interface, for better compatibility
+  between models and with the parallel LMDZ.COMMON dyn core. Main structural
+  changes are:
+* misc: (replaces what was the "bibio" directory)
+- Should only contain extremely generic (and non physics or
+  dynamics-specific) routines
+* dynlonlat_phylonlat: (new interface directory)
+- This directory contains routines relevent to physics/dynamics grid
+  interactions, e.g. routines gr_dyn_fi or gr_fi_dyn and calfis
+- Moreover the dynlonlat_phylonlat contains directory "phymars".
+  This subdirectories should only contain specific interfaces (e.g. 
+  iniphysiq) or main programs (e.g. newstart or xvik).
+* phymars/dyn1d: this subdirectory contains the 1D model.
Index: /trunk/LMDZ.MARS/create_make_gcm
===================================================================
--- /trunk/LMDZ.MARS/create_make_gcm	(revision 1402)
+++ /trunk/LMDZ.MARS/create_make_gcm	(revision 1403)
@@ -11,7 +11,13 @@
 #          ., dyn3d and grid
 #
+
+# arguments given to create_make_gcm are the directories to scan
+src_dirs=$*
+
 machine=`hostname`
 os=`uname`
 gcm=`pwd`
+logfile=$gcm/create_make_gcm.log
+rm -f $logfile ; touch -f $logfile
 libf=$gcm/libf
 libo=$gcm/libo
@@ -51,5 +57,5 @@
 #echo $localdir
 echo "LOCAL_DIR=`echo $localdir`"
-echo 'BIBIO    = $(LIBF)/bibio'
+echo 'MISC    = $(LIBF)/misc'
 echo 'AERONOMARS    = $(LIBF)/aeronomars'
 echo "FILTRE   = filtre"
@@ -57,4 +63,5 @@
 echo 'DYN  = $(DYNTYPE)'
 echo 'LIBPHY = $(LIBO)/libphy$(PHYS).a'
+echo 'LIBDYN_PHY = $(LIBO)/libdynlmdz_phy$(PHYS).a'
 echo 'DIRMAIN= $(DYN)$(DIM)d'
 echo 'RM=rm'
@@ -64,25 +71,11 @@
 echo '# Les differentes librairies pour l"edition des liens:'
 echo
-if [ "$XNEC" = '1' ] ; then
-  echo 'dyn3d      = $(LIBO)/libsxdyn3d.a $(LIBO)/libsx$(FILTRE).a'
-  echo 'dyn2d      = $(LIBO)/libsxdyn2d.a'
-  echo 'dyn1d      = $(LIBO)/libsxdyn1d.a'
-  echo 'L_DYN      = -lsxdyn$(DIM)d'
-  echo 'L_FILTRE   = -lsx$(FILTRE)'
-  echo 'L_PHY = -lsxphy$(PHYS) '
-  echo 'L_BIBIO    = -lsxbibio'
-  echo 'L_AERONOMARS    = -lsxaeronomars'
-  echo 'L_ADJNT    ='
-else
-  echo 'dyn3d      = $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
-  echo 'dyn2d      = $(LIBO)/libdyn2d.a'
-  echo 'dyn1d      = $(LIBO)/libdyn1d.a'
-  echo 'L_DYN      = -l$(DYN)$(DIM)d'
-  echo 'L_FILTRE   = -l$(FILTRE)'
-  echo 'L_PHY = -lphy$(PHYS) '
-  echo 'L_BIBIO    = -lbibio'
-  echo 'L_AERONOMARS    = -laeronomars'
-  echo 'L_ADJNT    ='
-fi
+echo 'L_DYN      = -ldyn$(DIM)d'
+echo 'L_FILTRE   = -l$(FILTRE)'
+echo 'L_DYN_PHY = -ldynlmdz_phy$(PHYS) '
+echo 'L_PHY = -lphy$(PHYS) '
+echo 'L_MISC    = -lmisc'
+echo 'L_AERONOMARS    = -laeronomars'
+echo 'L_ADJNT    ='
 echo
 echo "#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
@@ -105,13 +98,14 @@
 echo
 echo "PROG = code"
-echo
-echo 'main : $(DYN) bibio phys aeronomars $(OPTION_DEP) '
+echo 'DYN  = dyn$(DIM)d'
+echo
+echo 'main : $(DYN) misc phys dyn_phy aeronomars $(OPTION_DEP) '
 echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '	cd $(LOCAL_DIR); \'
 echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
 if [ "$CRAY" = '0' ] ; then
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_DYN_PHY) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_DYN_PHY) $(L_MISC) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 else
-echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_BIBIO) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
+echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_DYN_PHY) $(L_ADJNT) $(L_FILTRE) $(L_AERONOMARS) $(L_PHY) $(L_DYN_PHY) $(L_MISC) $(L_DYN) $(L_AERONOMARS) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 fi
 echo
@@ -122,5 +116,11 @@
 echo 'phys : $(LIBPHY)'
 echo
-echo 'bibio : $(LIBO)/libbibio.a'
+echo 'dyn3d : $(LIBO)/libdyn3d.a $(LIBO)/lib$(FILTRE).a'
+echo 'dyn2d : $(LIBO)/libdyn2d.a'
+echo 'dyn1d : '
+echo
+echo 'dyn_phy: $(LIBDYN_PHYS)'
+echo
+echo 'misc : $(LIBO)/libmisc.a'
 echo
 echo 'aeronomars : $(LIBO)/libaeronomars.a'
@@ -140,122 +140,121 @@
 echo
 cd $libf >/dev/null 2>&1
-for diri in ` ls `
-do
+
+for diri in $src_dirs ; do
+
    if [ -d $diri ] ; then
-   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.F90`" != "" ]  ; then 
-      cd $diri >/dev/null 2>&1
+   if [ "`ls $diri/*.F`" != "" ] || [ "`ls $diri/*.[fF]90`" != "" ]  ; then 
+#      cd $diri >/dev/null 2>&1
       echo
       listlib=""
-      for i in `ls *.F`
-      do
-         fili=`basename $i .F`
+# Liste des fichiers .F et .F90 n'etant pas des programmes principaux
+      for fili in `ls $diri/*.[fF]` ; do
          # Check if file is a routine or main program
          # i.e: look for the "program" keword preceeded by leading spaces
-         test=` (  head $i | grep -i '^ *program' ) `
-         if [ "$test" = "" ] ; then 
-            # if it is not a main program, add it to the list
-            listlib=$listlib" "$fili
-         fi
-      done
-      for i in `ls *.F90`
-      do
-         fili=`basename $i .F90`
+         test=` (  head $fili | grep -i '^ *program' ) `
+         # if it is not a main program, add it to the list
+         if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi
+      done
+      for fili in `ls $diri/*.[fF]90` ; do
          # Check if file is a routine or main program
          # i.e. look for "program" keyword (with possibly some leading spaces)
-         test=` (  head $i | grep -i '^ \{0,\}program' ) `
-         if [ "$test" = "" ] ; then
-            # if it is not a main program, add it to the list
-            listlib=$listlib" "$fili
-         fi 
-      done
-#
-      echo
-      echo
-      echo "#======================================================================="
+         test=` (  head $fili | grep -i '^ \{0,\}program' ) `
+         # if it is not a main program, add it to the list
+         if [ "$test" = "" ] ; then listlib=$listlib" "$fili ; fi 
+      done
+      echo
+      echo $listlib >> $logfile
+      echo
+      # topdiri contains main dir name (without trailing "/blabla" for subdirs)
+      topdiri=${diri%/*}
+      echo "#=================================================================="
       echo "# Contenu de la bibliotheque correspondant au Directory "$diri
-      echo "#======================================================================="
-      echo
-      for fili in $listlib
-      do
-         echo '$(LIBO)/lib'$diri".a : " '$(LIBO)/lib'$diri".a("$fili".o)"
+      echo "#=================================================================="
+      echo
+      for trufile in $listlib ; do
+         fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1`
+         echo '$(LIBO)/lib'$topdiri".a : " '$(LIBO)/lib'$topdiri".a("$fili".o)"
          echo
       done
-      echo '.PRECIOUS	: $(LIBO)/lib'$diri'.a'
-      echo
-      echo
-      echo "# Compilation des membres de la bibliotheque lib"$diri".a"
-      echo
-      for fili in $listlib
-      do
-         if [ -f $fili.F90 ] ; then
-           trufile=$fili.F90
-         else
-           trufile=$fili.F
-         fi
+      echo '.PRECIOUS	: $(LIBO)/lib'$topdiri'.a'
+      echo
+      echo
+      echo "# Compilation of elements in $diri of library lib"$topdiri".a"
+      echo
+      for trufile in $listlib ; do
+         fili=`echo $trufile | awk -F/ ' { print $NF } ' | cut -d. -f1`
          F90=0 ; egrep -i '^ *use ' $trufile > /dev/null 2>&1 && F90=1
                  egrep -i '^ *module ' $trufile > /dev/null 2>&1 && F90=1
                  egrep -i '#include*.inc ' $trufile > /dev/null 2>&1 && F90=1
-         str1='$(LIBO)/lib'$diri'.a('$fili'.o) : $(LIBF)/'$diri/$trufile
-         [ "$fili" = "chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
-         for stri in ` ( sed -n "/\#include/s/\#include//p" $trufile | sed 's/\"//g' ; egrep -i '^ *use ' $trufile | sed -e 's/,/ /' | awk ' { print $2 } ' ) `
-         do
-            stri=`echo $stri | tr [A-Z] [a-z]`
-            if [ -f $stri ] ; then
+         str1='$(LIBO)/lib'$topdiri'.a('$fili'.o) : $(LIBF)/'$trufile
+         [ "$fili" = "$diri/chem.subs" ] && str1=$str1' $(LIBF)/'$diri/chem.mods.F
+
+##########################################################################
+# TRAITEMENT DES DEPENDANCES
+# Differents cas de dependance correspondant a des include ou des
+# use module.
+# soit dans le repertoire local soit dans un autre.
+# Pour dyn3d, il faudrait remplacer la chaine de caractere par $DYN
+# ou quelque chose du genre.
+##########################################################################
+
+         for stri in ` ( sed -e '/^[cC\!]/d' $trufile | sed -e "/\#include /s/\#include /XXnclude /" -e "/include /s/include /XXnclude /" -e "/INCLUDE /s/INCLUDE /XXnclude /" | sed -n "/XXnclude /s/XXnclude//p" | sed 's/\"//g' | sort | uniq ; sed -e '/^[cC\!]/d' $trufile | egrep -i '^ *use ' | sed -e 's/,/ /' | awk ' { print $2 } ' | sort | uniq ) ` ; do
+            echo $trufile $fili $stri >> $logfile
+            strj=`echo $stri | tr [A-Z] [a-z]`
+            str2=""
+            for dirinc in $src_dirs ; do
+# Recherche dans l'ordre hierarchique inverse car seule la derniere
+# ligne est conservee
+#               if [ $dirinc = phydev ] ; then
+#                   dirstr='$(PHYS)'
+#                   libstr='phy$(PHYS)'
+#               else
+                   dirstr=$dirinc
+                   libstr=$dirinc
+#               fi
+               echo dirinc $dirinc >> $logfile
+               if [ -f $dirinc/$stri ] ; then
+                  str2='$(LIBF)/'$dirstr/$stri
+               elif [ -f $dirinc/$strj ] ; then
+                  str2='$(LIBF)/'$dirstr/$stri
+               elif [ -f $dirinc/$strj.[fF]90 ]  || [ -f $dirinc/$strj.[fF] ]  ; then 
+                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
+                  str2='$(LIBO)/lib'$strlib'.a('$strj'.o)'
+               elif [ -f $dirinc/$stri.[fF]90 ]  || [ -f $dirinc/$stri.[fF] ]  ; then 
+                  strlib=`echo $libstr | awk -F/ ' { print $1 } '`
+                  str2='$(LIBO)/lib'$strlib'.a('$stri'.o)'
+               fi
+               echo stri $stri  >> $logfile
+               echo str2 $str2  >> $logfile
+            done
+               echo dernier str2 $str2  >> $logfile
+            if [ "$str2" = "" ] ; then
+               echo Warn: Include $diri $trufile $fili $stri pas trouve >> $logfile
+            elif [ "$str2" = "$str1" ] ; then
+               echo Warn: Include $diri $trufile $fili $stri $str1 trouve 2x >> $logfile
+            else
                echo $str1 \\
-               str1='$(LIBF)/'$diri'/'$stri
-            else
-               if [ -f $stri.F ] || [ -f $stri.F90 ] ; then
-                  echo $str1 \\
-                  str1='$(LIBO)/lib'$diri'.a('$stri'.o)'
-               else
-#                  for dirinc in dyn3d grid bibio aeronomars phymars
-                  for dirinc in $*
-                  do
-                     if [ -f ../$dirinc/$stri ] ; then
-                        echo $str1 \\
-                        str1='$(LIBF)/'`cd .. ; ls */$stri | head -1`
-                     fi
-                     if [ -f ../$dirinc/$stri.F90 ] ; then
-                        echo $str1 \\
-                        str1='$(LIBO)/lib'$dirinc'.a('$stri'.o)'
-                     fi
-                  done
-               fi
+               str1=$str2
             fi
-         done
+         done # Fin de la boucle sur les dependances et ecriture de la derniere
          echo $str1
-         # Compile in LOCAL_DIR directory, and before compiling,
-         # remove the object from the library
-         echo '	cd $(LOCAL_DIR); \'
-         echo '	$(AR) d $(LIBO)/lib'$diri'.a '$fili'.o ; \'
+         # Compile in LIBO directory; and before compiling, remove
+         # object from library
+         echo '	cd $(LIBO); \'
+         echo '	$(AR) d $(LIBO)/lib'$topdiri'.a '$fili'.o ; \'
 	 if [ "$F90" -eq '0' ] ; then
          ## Fixed Form Fortran 77
-	   echo '	$(COMPILE) $(LIBF)/'$diri'/'$trufile' ; \'
+	   echo '	$(COMPILE) $(LIBF)/'$trufile' ; \'
 	 else
          ## Fortran 90
-           if [ -f $fili.F90 ] ; then
-	   ## Free Form Fortran 90
-              echo '	$(COMPTRU90) $(LIBF)/'$diri'/'$trufile' ; \'
+           if [ `echo $trufile | cut -d. -f2` = F90 ] ; then
+	      ## Free Form
+              echo '	$(COMPTRU90) $(LIBF)/'$trufile' ; \'
            else
-	   ## Fixed Form Fortran 90
-              echo '	$(COMPILE90) $(LIBF)/'$diri'/'$trufile' ; \'
+	      echo '	$(COMPILE90) $(LIBF)/'$trufile' ; \'
            fi
-           ## If a module, handle created module descriptor file
-           MODU=0; egrep -i '^ *module ' $trufile> /dev/null 2>&1 && MODU=1
-            if [ "$MODU" -eq '1' -a "$CRAY" != '1' ] ; then
-              if [ "$os" = 'UNIX_System_V' ] ; then
-                echo '	cp $(MOD_LOC_DIR)/*.$(MOD_SUFFIX) $(LIBO)/ ; \'
-              else
-                echo '	mv $(MOD_LOC_DIR)/'$fili'.$(MOD_SUFFIX) $(LIBO)/'$fili'.$(MOD_SUFFIX) ; \'
-#                echo '	if [ "$(MOD_LOC_DIR)" ne "$(LIBO)" ] ; then mv $(MOD_LOC_DIR)/'*'.$(MOD_SUFFIX) $(LIBO) ; fi ; \'
-              fi
-            fi
 	 fi
-	 if ( [ "$XNEC" -eq '1' ] || [ "$X6NEC" = '1' ] || [ "$X8BRODIE" = '1' ] ) ; then
-           echo '	sxar r $(LIBO)/libsx'$diri'.a '$fili'.o ; \'
-         fi
          # Put generated object in library
-         echo '	$(AR) r $(LIBO)/lib'$diri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
-         echo '	cd $(GCM)'
+         echo '	$(AR) r $(LIBO)/lib'$topdiri'.a '$fili'.o ; $(RM) '$fili'.o ; \'
 	 echo
       done
Index: unk/LMDZ.MARS/libf/dyn3d/calfis.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/calfis.F	(revision 1402)
+++ 	(revision )
@@ -1,554 +1,0 @@
-      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
-     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
-     $            pducov,pdvcov,pdteta,pdq,pw,
-     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
-c
-c    Auteur :  P. Le Van, F. Hourdin 
-c   .........
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   1. rearrangement des tableaux et transformation
-c      variables dynamiques  >  variables physiques
-c   2. calcul des termes physiques
-c   3. retransformation des tendances physiques en tendances dynamiques
-c
-c   remarques:
-c   ----------
-c
-c    - les vents sont donnes dans la physique par leurs composantes 
-c      naturelles.
-c    - la variable thermodynamique de la physique est une variable
-c      intensive :   T 
-c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
-c    - les deux seules variables dependant de la geometrie necessaires
-c      pour la physique sont la latitude pour le rayonnement et 
-c      l'aire de la maille quand on veut integrer une grandeur 
-c      horizontalement.
-c    - les points de la physique sont les points scalaires de la 
-c      la dynamique; numerotation:
-c          1 pour le pole nord
-c          (jjm-1)*iim pour l'interieur du domaine
-c          ngridmx pour le pole sud
-c      ---> ngridmx=2+(jjm-1)*iim
-c
-c     Input :
-c     -------
-c       ecritphy        frequence d'ecriture (en jours)de histphy
-c       pucov           covariant zonal velocity
-c       pvcov           covariant meridional velocity 
-c       pteta           potential temperature
-c       pps             surface pressure
-c       pmasse          masse d'air dans chaque maille
-c       pts             surface temperature  (K)
-c       pw              flux vertical (kg/s)
-c
-c    Output :
-c    --------
-c        pdufi          tendency for the natural zonal velocity (ms-1)
-c        pdvfi          tendency for the natural meridional velocity 
-c        pdhfi          tendency for the potential temperature
-c        pdtsfi         tendency for the surface temperature
-c
-c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-
-      INTEGER ngridmx,nq
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-!#include "control.h"
-
-c    Arguments :
-c    -----------
-      LOGICAL  lafin
-      REAL heure
-
-      REAL pvcov(iip1,jjm,llm)
-      REAL pucov(iip1,jjp1,llm)
-      REAL pteta(iip1,jjp1,llm)
-      REAL pmasse(iip1,jjp1,llm)
-      REAL pq(iip1,jjp1,llm,nq)
-      REAL pphis(iip1,jjp1)
-      REAL pphi(iip1,jjp1,llm)
-c
-      REAL pdvcov(iip1,jjm,llm)
-      REAL pducov(iip1,jjp1,llm)
-      REAL pdteta(iip1,jjp1,llm)
-      REAL pdq(iip1,jjp1,llm,nq)
-c
-      REAL pw(iip1,jjp1,llm)
-c
-      REAL pps(iip1,jjp1)
-      REAL pp(iip1,jjp1,llmp1)
-      REAL ppk(iip1,jjp1,llm)
-c
-      REAL pdvfi(iip1,jjm,llm)
-      REAL pdufi(iip1,jjp1,llm)
-      REAL pdhfi(iip1,jjp1,llm)
-      REAL pdqfi(iip1,jjp1,llm,nq)
-      REAL pdpsfi(iip1,jjp1)
-      logical tracer
-
-c    Local variables :
-c    -----------------
-
-      INTEGER i,j,l,ig0,ig,iq
-      REAL zpsrf(ngridmx)
-      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
-      REAL zphi(ngridmx,llm),zphis(ngridmx)
-c
-      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
-      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nq)
-c
-      REAL zvervel(ngridmx,llm)
-c
-      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
-      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nq)
-      REAL zdpsrf(ngridmx)
-c
-      REAL zsin(iim),zcos(iim),z1(iim)
-      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
-      REAL unskap, pksurcp
-c
-      
-      EXTERNAL gr_dyn_fi,gr_fi_dyn
-      EXTERNAL physiq,multipl
-      REAL SSUM
-      EXTERNAL SSUM
-
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-
-      LOGICAL firstcal, debut
-      DATA firstcal/.true./
-      SAVE firstcal,debut
-      REAL rdayvrai,rday_ecri
-c
-c-----------------------------------------------------------------------
-c
-c    1. Initialisations :
-c    --------------------
-c
-
-
-      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         PRINT*,'STOP dans calfis'
-         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         PRINT*,'  ngridmx  jjm   iim   '
-         PRINT*,ngridmx,jjm,iim
-         STOP
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   latitude, longitude et aires des mailles pour la physique:
-c   ----------------------------------------------------------
-
-c
-      IF ( firstcal )  THEN
-          debut = .TRUE.
-      ELSE
-          debut = .FALSE.
-      ENDIF
-
-c
-!      IF (firstcal) THEN
-!         latfi(1)=rlatu(1)
-!         lonfi(1)=0.
-!         DO j=2,jjm
-!            DO i=1,iim
-!               latfi((j-2)*iim+1+i)= rlatu(j)
-!               lonfi((j-2)*iim+1+i)= rlonv(i)
-!            ENDDO
-!         ENDDO
-!         latfi(ngridmx)= rlatu(jjp1)
-!         lonfi(ngridmx)= 0.
-!         
-!         ! build airefi(), mesh area on physics grid
-!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-!         ! Poles are single points on physics grid
-!         airefi(1)=airefi(1)*iim
-!         airefi(ngridmx)=airefi(ngridmx)*iim
-!
-!         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
-!     .                latfi,lonfi,airefi,rad,g,r,cpp)
-!      ENDIF
-
-c
-c-----------------------------------------------------------------------
-c   40. transformation des variables dynamiques en variables physiques:
-c   ---------------------------------------------------------------
-
-c   41. pressions au sol (en Pascals)
-c   ----------------------------------
-
-       
-      zpsrf(1) = pps(1,1)
-
-      ig0  = 2
-      DO j = 2,jjm
-         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
-         ig0 = ig0+iim
-      ENDDO
-
-      zpsrf(ngridmx) = pps(1,jjp1)
-
-
-c   42. pression intercouches :
-c
-c   -----------------------------------------------------------------
-c     .... zplev  definis aux (llm +1) interfaces des couches  ....
-c     .... zplay  definis aux (  llm )    milieux des couches  .... 
-c   -----------------------------------------------------------------
-
-c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
-c
-       unskap   = 1./ kappa
-c
-      DO l = 1, llmp1
-        zplev( 1,l ) = pp(1,1,l)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              zplev( ig0,l ) = pp(i,j,l)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        zplev( ngridmx,l ) = pp(1,jjp1,l)
-      ENDDO
-c
-c
-
-c   43. temperature naturelle (en K) et pressions milieux couches .
-c   ---------------------------------------------------------------
-
-      DO l=1,llm
-
-         pksurcp     =  ppk(1,1,l) / cpp
-         zplay(1,l)  =  preff * pksurcp ** unskap
-         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
-         ig0         =  2
-
-         DO j = 2, jjm
-            DO i = 1, iim
-              pksurcp        = ppk(i,j,l) / cpp
-              zplay(ig0,l)   = preff * pksurcp ** unskap
-              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
-              ig0            = ig0 + 1
-            ENDDO
-         ENDDO
-
-         pksurcp       = ppk(1,jjp1,l) / cpp
-         zplay(ig0,l)  = preff * pksurcp ** unskap
-         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
-
-      ENDDO
-
-      DO l=1, llm
-        DO ig=1,ngridmx
-             if (ztfi(ig,l).lt.15) then
-                  write(*,*) 'New Temperature below 15 K !!! '
-	              write(*,*) 'Stop in calfis.F '
-	              write(*,*) 'ig=', ig, ' l=', l
-                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
-                  stop
-             end if
-        ENDDO
-      ENDDO
-
-
-
-c   43.bis Taceurs (en kg/kg)
-c   --------------------------
-      DO iq=1,nq
-         DO l=1,llm
-            zqfi(1,l,iq) = pq(1,1,l,iq)
-            ig0          = 2
-            DO j=2,jjm
-               DO i = 1, iim
-                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
-                  ig0             = ig0 + 1
-               ENDDO
-            ENDDO
-            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
-         ENDDO
-      ENDDO
-
-c   Geopotentiel calcule par rapport a la surface locale:
-c   -----------------------------------------------------
-
-      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
-      DO l=1,llm
-         DO ig=1,ngridmx
-            zphi(ig,l)=zphi(ig,l)-zphis(ig)
-         ENDDO
-      ENDDO
-
-c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
-c   -------------------------------
-c     pw est en kg/s
-c On interpole "lineairement" la temperature entre les couches(FF,10/95)
-
-!      DO ig=1,ngridmx
-!         zvervel(ig,1)=0.
-!      END DO
-!      DO l=2,llm
-!        zvervel(1,l)=(pw(1,1,l)/apoln)
-!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
-!        ig0=2
-!       DO j=2,jjm
-!           DO i = 1, iim
-!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
-!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!              ig0 = ig0 + 1
-!           ENDDO
-!       ENDDO
-!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
-!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!      ENDDO
-
-c    .........  Reindexation : calcul de zvervel au MILIEU des couches
-!       DO l=1,llm-1
-!	      DO ig=1,ngridmx
-!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
-!          END DO 
-!       END DO 
-c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
-
-c   45. champ u:
-c   ------------
-
-      DO 50 l=1,llm
-
-         DO 25 j=2,jjm
-            ig0 = 1+(j-2)*iim
-            zufi(ig0+1,l)= 0.5 * 
-     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
-            DO 10 i=2,iim
-               zufi(ig0+i,l)= 0.5 *
-     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
-10         CONTINUE
-25      CONTINUE
-
-50    CONTINUE
-
-
-c   46.champ v:
-c   -----------
-
-      DO l=1,llm
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               zvfi(ig0+i,l)= 0.5 *
-     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
-            ENDDO
-         ENDDO
-      ENDDO
-
-
-c   47. champs de vents aux pole nord   
-c   ------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
-         ENDDO
-
-         DO i=1,iim
-            zcos(i)   = COS(rlonv(i))*z1(i)
-            zcosbis(i)= COS(rlonv(i))*z1bis(i)
-            zsin(i)   = SIN(rlonv(i))*z1(i)
-            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
-         ENDDO
-
-         zufi(1,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-
-c   48. champs de vents aux pole sud:
-c   ---------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
-      ENDDO
-
-         DO i=1,iim
-            zcos(i)    = COS(rlonv(i))*z1(i)
-            zcosbis(i) = COS(rlonv(i))*z1bis(i)
-            zsin(i)    = SIN(rlonv(i))*z1(i)
-            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
-      ENDDO
-
-         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   Appel de la physique:
-c   ---------------------
-
-
-      CALL physiq (ngridmx,llm,nq,
-     ,     debut,lafin,
-     ,     rday_ecri,heure,dtphys,
-     ,     zplev,zplay,zphi,
-     ,     zufi, zvfi,ztfi, zqfi,  
-!     ,     zvervel,
-     ,     pw,
-C - sorties
-     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
-
-
-c-----------------------------------------------------------------------
-c   transformation des tendances physiques en tendances dynamiques:
-c   ---------------------------------------------------------------
-
-c  tendance sur la pression :
-c  -----------------------------------
-
-      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
-c
-ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
-
-c   62. enthalpie potentielle
-c   ---------------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
-          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
-            ENDDO
-               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   62. humidite specifique
-c   ---------------------
-
-      DO iq=1,nq
-         DO l=1,llm
-            DO i=1,iip1
-               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
-               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
-            ENDDO
-            DO j=2,jjm
-               ig0=1+(j-2)*iim
-               DO i=1,iim
-                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
-               ENDDO
-               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
-            ENDDO
-         ENDDO
-      ENDDO
-
-c   65. champ u:
-c   ------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-            pdufi(i,1,l)    = 0.
-            pdufi(i,jjp1,l) = 0.
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim-1
-               pdufi(i,j,l)=
-     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
-            ENDDO
-            pdufi(iim,j,l)=
-     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
-            pdufi(iip1,j,l)=pdufi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   67. champ v:
-c   ------------
-
-      DO l=1,llm
-
-         DO j=2,jjm-1
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdvfi(i,j,l)=
-     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
-            ENDDO
-            pdvfi(iip1,j,l) = pdvfi(1,j,l)
-         ENDDO
-      ENDDO
-
-
-c   68. champ v pres des poles:
-c   ---------------------------
-c      v = U * cos(long) + V * SIN(long)
-
-      DO l=1,llm
-
-         DO i=1,iim
-            pdvfi(i,1,l)=
-     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
-            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
-     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
-            pdvfi(i,1,l)=
-     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
-            pdvfi(i,jjm,l)=
-     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
-          ENDDO
-
-         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
-         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-
-700   CONTINUE
-
-      firstcal = .FALSE.
-
-      RETURN
-      END
Index: /trunk/LMDZ.MARS/libf/dyn3d/gcm.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1402)
+++ /trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1403)
@@ -5,4 +5,5 @@
      &                       nday_r, idissip, iconser, ecritstart,
      &                       ecritphy
+      use filtreg_mod, only: inifilr
 !      use comgeomphy, only: initcomgeomphy
       IMPLICIT NONE
@@ -107,5 +108,5 @@
 
       EXTERNAL caldyn, traceur
-      EXTERNAL dissip,geopot,iniconst,inifilr
+      EXTERNAL dissip,geopot,iniconst
       EXTERNAL integrd,SCOPY
       EXTERNAL inigeom
Index: unk/LMDZ.MARS/libf/dyn3d/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/gr_dyn_fi.F	(revision 1402)
+++ 	(revision )
@@ -1,37 +1,0 @@
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-            ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: unk/LMDZ.MARS/libf/dyn3d/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/gr_fi_dyn.F	(revision 1402)
+++ 	(revision )
@@ -1,38 +1,0 @@
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: unk/LMDZ.MARS/libf/dyn3d/grid_noro1.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/grid_noro1.F	(revision 1402)
+++ 	(revision )
@@ -1,423 +1,0 @@
-      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
-     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Calcul des parametres de l'orographie sous-maille necessaires
-c      au nouveau shema de representation des montagnes meso-echelles
-c      dans le modele.  Les points sont mis sur une grille rectangulaire
-c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
-c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
-c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
-c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
-c      en j=1.  
-c      Les parametres a,b,c,d representent les limites de la region
-c      de point de grille correspondant a un point decrit precedemment.
-c      Les moyennes sur ces regions des valeurs calculees a partir de
-c      l'USN, sont ponderees par un poids, fonction de la surface
-c      occuppe par ces donnees a l'interieure de la grille du modele.
-c      Dans la plupart des cas ce poid est le rapport entre la surface
-c      de la region de point de grille USN et la surface de la region
-c      de point de grille du modele.
-c       
-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 et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c        dans ce programme, on assume que les donnees sont les altitudes
-c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        les champs de sorties sont sur une grille physique:
-c             zmea:  orographie moyenne
-c             zstd:  deviation standard de l'orographie sous-maille
-c             zsig:  pente de l'orographie sous-maille 
-c             zgam:  anisotropy de l'orographie sous maille
-c             zthe:  orientation de l'axe oriente dans la direction
-c                    de plus grande pente de l'orographie sous maille
-C=======================================================================
-c     IMPLICIT INTEGER (I,J)
-c     IMPLICIT REAL(X,Z) 
-       implicit none
-       integer iusn,jusn,iext
-       parameter(iusn=360,jusn=180,iext=40)
-c!-*-      include 'param1'
-c!-*-      include 'comcstfi.h'
-#include "dimensions.h"
-#include "comconst.h"
-c!-*-
-c!-*-      parameter(iim=cols,jjm=rows)
-      REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
-
-c   modif declarations pour implicit none
-      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
-      real zsigsud,zweinor,zweisud
-      real xk,xl,xm,xw,xp,xq
-      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
-      real zbordnor,zbordsud,zbordest,zbordoue,xpi
-      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
-      integer i,j,ii,jj,ideltax,ihalph
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL weight(iim+1,jjm+1)
-      REAL x(imar+1),y(jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-c
-c  quelques constantes:
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      print*,'rad =',rad
-      print*,'Long et lat entree'
-      print*,(x(i),i=1,imar+1)
-      print*,(y(j),j=1,jmar)
-       print*,'Long et lat donnees'
-      print*,(xdata(i),i=1,imdep)
-      print*,(ydata(j),j=1,jmdep)
-
-      xpi=acos(-1.)
-      zdeltay=2.*xpi/real(jusn)*rad
-c
-c  quelques tests de dimensions:
-c    
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
-        print *,' imar ou jmar mal dimensionnes:',imar,jmar
-        call abort
-      ENDIF
-c
-C  Extension de la base de donnee de l'USN pour faciliter
-C  les calculs ulterieurs:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=entree(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=entree(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=entree(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c
-c  Calcul d'une orographie filtree aux hautes latitudes
-c  pour permettre des calculs plus isotropiques sur la pente
-c  des montagnes
-c
-       DO i=1,IUSN+2*iext
-       DO J=1,JUSN+2
-          zusnfi(i,j)=0.0
-       ENDDO
-       ENDDO
-
-      DO j=1,jusn
-            ideltax=1./cos(yusn(j+1))
-            ideltax=min(iusn/2-1,ideltax)
-            IF(MOD(IDELTAX,2).EQ.0)THEN
-              IDELTAX=IDELTAX+1
-            ENDIF
-            IHALPH=(IDELTAX-1)/2 
-c           print *,' ideltax=',ideltax
-         IF(ideltax.eq.1)THEN
-            DO i=1,iusn
-               zusnfi(i+iext,j+1)=entree(i,j)
-            ENDDO   
-         ELSE
-            DO i=1,ihalph
-               DO ii=1,i+ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               DO ii=ihalph-i,0,-1
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
-               ENDDO  
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO   
-            DO i=iusn-ihalph+1,iusn
-               DO ii = i-ihalph,iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO 
-               DO ii = 1,ihalph+i-iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO
-            DO i=ihalph+1,iusn-ihalph
-               DO ii=-ihalph,ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO
-         ENDIF
-            DO i=1,iext
-               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
-               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
-            ENDDO
-      ENDDO
-c  
-c Calculer les limites des zones des nouveaux points
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/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      quelques initialisations:
-      print*,'OKM1'
-c
-      DO i = 1, imar
-      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
-         zstd(i,j)=0.0
-      ENDDO
-      ENDDO
-c
-c  calculs des correlations de pentes sur la grille de l'USN.
-c
-         DO j = 2,jusn+1 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
-         ENDDO
-
-         ENDDO
-
- 
-
-      print*,'OK0'
-c
-c  sommations des differentes quantites definies precedemment
-c  sur une grille du modele.
-c 
-      zleny=xpi/real(jusn)*rad
-      xincr=xpi/2./real(jusn)
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=amax1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=amax1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            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
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  calculs des differents parametres necessaires au programme
-c  de parametrisation de l'orographie a l'echelle moyenne:
-c
-      zmaxmea=0.
-      zmaxstd=0.
-      zmaxsig=0.
-      zmaxgam=0.
-      zmaxthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       print*,'OK1'
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c       print*,'ok0'
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Orography moyenne:
-c         print*,'ok1'
-           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         print*,'ok2'
-c  Deviation standard:
-           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-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          print*,'ok3'
-c pente: 
-           zsig(ii,jj)=sqrt(xq)
-c           zsig(ii,jj)=sqrt(2.*xk)
-c isotropy:
-           zgam(ii,jj)=xp/xq
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
-
-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)     
-c          print*,'ok4'
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-c          print*,'ok1b'
-         ENDIF
-      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
-c         print*,'oka'
-      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
-c         print*,'okb'
-      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
-c         print*,'okc'
-      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
-c         print*,'okd'
-      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
-c         print*,'oke'
-      zminthe=amin1(zthe(ii,jj),zminthe)
-c      print*,'ok5'
-       ENDDO
-       ENDDO
-
-      print *,'  MEAN ORO:',zmaxmea
-	  print *,'  ST. DEV.:',zmaxstd
-      print *,'  PENTE:',zmaxsig
-      print *,' ANISOTROP:',zmaxgam
-      print *,'  ANGLE:',zminthe,zmaxthe	
-      
-C
-c  On passe ce donnees sur la grille dite physique....(?)
-c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
-c  n'ont pas vraiment de sens
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(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
-
-      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)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/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
Index: unk/LMDZ.MARS/libf/dyn3d/interp_vert.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/interp_vert.F	(revision 1402)
+++ 	(revision )
@@ -1,70 +1,0 @@
-c******************************************************
-      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
-     &             aps,bps,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**********************************************************
-
-      IMPLICIT NONE
-
-c   Declarations:
-c ==============
-c
-c  ARGUMENTS
-c  """""""""
-
-       integer lmo ! dimensions ancienne couches (input)
-       integer lmn ! dimensions nouvelle couches (input)
-
-       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
-       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (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
-
-c run
-c ====
-
-      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.MARS/libf/dyn3d/logic.h
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/logic.h	(revision 1402)
+++ /trunk/LMDZ.MARS/libf/dyn3d/logic.h	(revision 1403)
@@ -1,10 +1,10 @@
-c-----------------------------------------------------------------------
-c INCLUDE 'logic.h'
+!-----------------------------------------------------------------------
+! INCLUDE 'logic.h'
 
-      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
-     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,         &
+     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
 
-      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
-     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser, &
+     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
 
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
Index: unk/LMDZ.MARS/libf/dyn3d/readhead_NC.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/readhead_NC.F	(revision 1402)
+++ 	(revision )
@@ -1,231 +1,0 @@
-      SUBROUTINE readhead_NC (fichnom,
-     .           day0,
-     .           phis,constR)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c  Adaptation à Mars : Yann Wanherdrick 
-c Objet: Lecture de l etat initial pour la physique
-c======================================================================
-#include "netcdf.inc"
-c====== includes de l ancien readhead ===
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "ener.h"
-#include "description.h"
-
-c======================================================================
-
-      CHARACTER*(*) fichnom
-      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
-      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
-
-      INTEGER radpas
-
-      REAL xmin, xmax
-c
-      INTEGER  i
-
-c   Variables
-c
-      INTEGER length,iq
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr, nid, nvarid
-      CHARACTER  str3*3
-
-c
-      INTEGER day0
-      REAL phis(ip1jmp1),constR
-c
-c Ouvrir le fichier contenant l etat initial:
-c
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        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*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <controle>'
-         CALL abort
-      ENDIF
-
-
-c Info sur la Planete Mars pour la dynamique 
-      im         = tab_cntrl(1)
-      jm         = tab_cntrl(2)
-      lllm       = tab_cntrl(3)
-      day_ini    = tab_cntrl(4)
-      rad        = tab_cntrl(5)
-      omeg       = tab_cntrl(6)
-      g          = tab_cntrl(7)
-c      mugaz      = tab_cntrl(8)
-      cpp        =  744.499
-      kappa      = tab_cntrl(9)
-      daysec     = tab_cntrl(10)
-      dtvr       = tab_cntrl(11)
-      etot0      = tab_cntrl(12)
-      ptot0      = tab_cntrl(13)
-      ztot0      = tab_cntrl(14)
-      stot0      = tab_cntrl(15)
-      ang0       = tab_cntrl(16)
-c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
-      preff=610.
-      WRITE (*,*) 'readhead -     preff ' , preff 
-c
-
-      day0=day_ini
-
-      constR=kappa*cpp
-      WRITE (*,*) 'constR = ' , constR
-      r=constR
-      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*, "readhead_NC: 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*, "readhead_NC: Lecture echouee pour <rlonu>"
-         CALL abort
-      ENDIF
-                                                                       
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: 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*, "readhead_NC: Lecture echouee pour rlatv"
-         CALL abort
-      ENDIF
-
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
-         CALL abort
-      ENDIF
-c
-c Lecture des aires des mailles:
-c
-      ierr = NF_INQ_VARID (nid, "aire", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <aire>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(aire)
-      xmax = MAXVAL(aire)
-      PRINT*,'Aires des mailles <aire>:', xmin, xmax
-c
-c Lecture du geopotentiel au sol:
-c
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <phis>'
-         CALL abort
-      ENDIF
-c      PRINT*,'READHEAD_NC  Phis:',phis
-
-      ierr = NF_INQ_VARID (nid, "aps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <aps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "bps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <bps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
-         CALL abort
-      ENDIF
-
-   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur parametree llm =',i4//)
-   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur  dtinteg =',i4//)
-
-      
-c Fermer le fichier:
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: unk/LMDZ.MARS/libf/dyn3d/scal_wind.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/scal_wind.F	(revision 1402)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      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.MARS/libf/dyn3d/serre.h
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/serre.h	(revision 1402)
+++ /trunk/LMDZ.MARS/libf/dyn3d/serre.h	(revision 1403)
@@ -1,6 +1,6 @@
-c..include serre.h
-c
-       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
-       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+!..include serre.h
+!
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: unk/LMDZ.MARS/libf/dyn3d/wind_scal.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dyn3d/wind_scal.F	(revision 1402)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      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.MARS/libf/dynlonlat_phylonlat/calfis.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
@@ -0,0 +1,554 @@
+      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
+     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
+     $            pducov,pdvcov,pdteta,pdq,pw,
+     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       pw              flux vertical (kg/s)
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature
+c        pdtsfi         tendency for the surface temperature
+c
+c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+
+      INTEGER ngridmx,nq
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+
+c    Arguments :
+c    -----------
+      LOGICAL  lafin
+      REAL heure
+
+      REAL pvcov(iip1,jjm,llm)
+      REAL pucov(iip1,jjp1,llm)
+      REAL pteta(iip1,jjp1,llm)
+      REAL pmasse(iip1,jjp1,llm)
+      REAL pq(iip1,jjp1,llm,nq)
+      REAL pphis(iip1,jjp1)
+      REAL pphi(iip1,jjp1,llm)
+c
+      REAL pdvcov(iip1,jjm,llm)
+      REAL pducov(iip1,jjp1,llm)
+      REAL pdteta(iip1,jjp1,llm)
+      REAL pdq(iip1,jjp1,llm,nq)
+c
+      REAL pw(iip1,jjp1,llm)
+c
+      REAL pps(iip1,jjp1)
+      REAL pp(iip1,jjp1,llmp1)
+      REAL ppk(iip1,jjp1,llm)
+c
+      REAL pdvfi(iip1,jjm,llm)
+      REAL pdufi(iip1,jjp1,llm)
+      REAL pdhfi(iip1,jjp1,llm)
+      REAL pdqfi(iip1,jjp1,llm,nq)
+      REAL pdpsfi(iip1,jjp1)
+      logical tracer
+
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+c
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nq)
+c
+      REAL zvervel(ngridmx,llm)
+c
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nq)
+      REAL zdpsrf(ngridmx)
+c
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+c
+      
+      EXTERNAL gr_dyn_fi,gr_fi_dyn
+      EXTERNAL physiq,multipl
+      REAL SSUM
+      EXTERNAL SSUM
+
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+
+      LOGICAL firstcal, debut
+      DATA firstcal/.true./
+      SAVE firstcal,debut
+      REAL rdayvrai,rday_ecri
+c
+c-----------------------------------------------------------------------
+c
+c    1. Initialisations :
+c    --------------------
+c
+
+
+      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         PRINT*,'STOP dans calfis'
+         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         PRINT*,'  ngridmx  jjm   iim   '
+         PRINT*,ngridmx,jjm,iim
+         STOP
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   latitude, longitude et aires des mailles pour la physique:
+c   ----------------------------------------------------------
+
+c
+      IF ( firstcal )  THEN
+          debut = .TRUE.
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+c
+!      IF (firstcal) THEN
+!         latfi(1)=rlatu(1)
+!         lonfi(1)=0.
+!         DO j=2,jjm
+!            DO i=1,iim
+!               latfi((j-2)*iim+1+i)= rlatu(j)
+!               lonfi((j-2)*iim+1+i)= rlonv(i)
+!            ENDDO
+!         ENDDO
+!         latfi(ngridmx)= rlatu(jjp1)
+!         lonfi(ngridmx)= 0.
+!         
+!         ! build airefi(), mesh area on physics grid
+!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+!         ! Poles are single points on physics grid
+!         airefi(1)=airefi(1)*iim
+!         airefi(ngridmx)=airefi(ngridmx)*iim
+!
+!         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
+!     .                latfi,lonfi,airefi,rad,g,r,cpp)
+!      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+
+c   42. pression intercouches :
+c
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+c
+       unskap   = 1./ kappa
+c
+      DO l = 1, llmp1
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+c
+c
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
+         ig0         =  2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
+
+      ENDDO
+
+      DO l=1, llm
+        DO ig=1,ngridmx
+             if (ztfi(ig,l).lt.15) then
+                  write(*,*) 'New Temperature below 15 K !!! '
+	              write(*,*) 'Stop in calfis.F '
+	              write(*,*) 'ig=', ig, ' l=', l
+                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
+                  stop
+             end if
+        ENDDO
+      ENDDO
+
+
+
+c   43.bis Taceurs (en kg/kg)
+c   --------------------------
+      DO iq=1,nq
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+            zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
+c   -------------------------------
+c     pw est en kg/s
+c On interpole "lineairement" la temperature entre les couches(FF,10/95)
+
+!      DO ig=1,ngridmx
+!         zvervel(ig,1)=0.
+!      END DO
+!      DO l=2,llm
+!        zvervel(1,l)=(pw(1,1,l)/apoln)
+!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
+!        ig0=2
+!       DO j=2,jjm
+!           DO i = 1, iim
+!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!              ig0 = ig0 + 1
+!           ENDDO
+!       ENDDO
+!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
+!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!      ENDDO
+
+c    .........  Reindexation : calcul de zvervel au MILIEU des couches
+!       DO l=1,llm-1
+!	      DO ig=1,ngridmx
+!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
+!          END DO 
+!       END DO 
+c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
+
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+      ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+      ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+
+      CALL physiq (ngridmx,llm,nq,
+     ,     debut,lafin,
+     ,     rday_ecri,heure,dtphys,
+     ,     zplev,zplay,zphi,
+     ,     zufi, zvfi,ztfi, zqfi,  
+!     ,     zvervel,
+     ,     pw,
+C - sorties
+     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
+
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
+
+c   62. enthalpie potentielle
+c   ---------------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
+            ENDDO
+               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   62. humidite specifique
+c   ---------------------
+
+      DO iq=1,nq
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+      ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+
+      firstcal = .FALSE.
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,37 @@
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
@@ -0,0 +1,38 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,453 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,211 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  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
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      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(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1906 @@
+!
+!$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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid2dTo1d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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, only: klon_glo, grid1dTo2d_glo
+    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)
+    if (ierr.ne.MPI_SUCCESS) then
+      write(*,*) "bcast_mpi error: ierr=",ierr
+      stop
+    endif
+#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.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -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(*,*)'--------> TASK ',omp_rank
+  WRITE(*,*)'omp_size =',omp_size
+  WRITE(*,*)'omp_rank =',omp_rank
+  WRITE(*,*)'is_omp_root =',is_omp_root
+  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(*,*)'klon_omp =',klon_omp
+  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(*,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -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, only: klon_omp, klon_omp_begin
+    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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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, only: klon_omp, klon_omp_begin
+  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.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,114 @@
+!
+!$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, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
+                               grid1dTo2d_glo, grid2dTo1d_glo
+  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(*,*) "------> 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(*,*) "------> 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(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -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.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/caldyn0.F
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F	(revision 1403)
@@ -0,0 +1,309 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,phisinit,alb,ith,z0,
+     &                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+! to use  'getin'
+       use ioipsl_getincom 
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+#include "datafile.h"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+! Arguments:
+      CHARACTER(len=3),intent(inout) :: relief
+      REAL,intent(out) :: phisinit(iimp1*jjp1)
+      REAL,intent(out) :: alb(iimp1*jjp1)
+      REAL,intent(out) :: ith(iimp1*jjp1)
+      REAL,intent(out) :: z0(iimp1*jjp1)
+      REAL,intent(out) :: zmea(imdp1*jmdp1)
+      REAL,intent(out) :: zstd(imdp1*jmdp1)
+      REAL,intent(out) :: zsig(imdp1*jmdp1)
+      REAL,intent(out) :: zgam(imdp1*jmdp1)
+      REAL,intent(out) :: zthe(imdp1*jmdp1)
+
+! Local variables:
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      INTEGER     ierr
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmxgdat
+      PARAMETER (klatdat=180,ngridmxgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(0:4)
+
+
+!#include "lmdstd.h"
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      write(*,*) 'datareadnc: opening file surface.nc'
+
+      datafile="/u/lmdz/WWW/planets/mars/datadir" ! default path to surface.nc
+      call getin("datadir",datafile) ! but users may specify another path
+      
+      ierr = NF_OPEN (trim(datafile)//'/surface.nc',
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file surface.nc '
+        write(*,*)'(in phymars/datareadnc.F)'
+        write(*,*)'It should be in :',trim(datafile),'/'
+        write(*,*)'1) You can set this path in the 
+     & callphys.def file:'
+        write(*,*)'   datadir=/path/to/the/datafiles'
+        write(*,*)'2) If necessary, surface.nc (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
+        CALL ABORT
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(0) = 'z0'
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' MOLA topography'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=0,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+      if (ierr.ne.nf_noerr) then
+        write(*,*) 'datareadnc error, cannot find ',trim(string(k))
+        write(*,*) ' in file ',trim(datafile),'/surface.nc'
+        stop
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+      if (ierr.ne.nf_noerr) then
+        write(*,*) 'datareadnc: error failed loading ',trim(string(k))
+        stop
+      endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          zdata(:)=1000.*zdata(:)
+          longitude(:)=(pi/180.)*longitude(:)
+          latitude(:)=(pi/180.)*latitude(:)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          CALL dump2d(iip1,jjp1,zmea,'zmea')
+          CALL dump2d(iip1,jjp1,zstd,'zstd')
+          CALL dump2d(iip1,jjp1,zsig,'zsig')
+          CALL dump2d(iip1,jjp1,zgam,'zgam')
+          CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.0) then                    ! z0
+         z0(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)*.01
+         ! multiplied by 0.01 to have z0 in m
+         CALL dump2d(iimp1,jjp1,z0,'z0 in m')
+      elseif (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      phisinit(1:iimp1*jjp1)=1000.*phisinit(1:iimp1*jjp1)
+      CALL dump2d(iimp1,jjp1,phisinit,'Altitude in m')
+      phisinit(:)=g*phisinit(:)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/defrun_new.F
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/exner_hyb.F
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F	(revision 1403)
@@ -0,0 +1,423 @@
+      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
+     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Calcul des parametres de l'orographie sous-maille necessaires
+c      au nouveau shema de representation des montagnes meso-echelles
+c      dans le modele.  Les points sont mis sur une grille rectangulaire
+c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
+c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
+c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
+c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
+c      en j=1.  
+c      Les parametres a,b,c,d representent les limites de la region
+c      de point de grille correspondant a un point decrit precedemment.
+c      Les moyennes sur ces regions des valeurs calculees a partir de
+c      l'USN, sont ponderees par un poids, fonction de la surface
+c      occuppe par ces donnees a l'interieure de la grille du modele.
+c      Dans la plupart des cas ce poid est le rapport entre la surface
+c      de la region de point de grille USN et la surface de la region
+c      de point de grille du modele.
+c       
+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 et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c        dans ce programme, on assume que les donnees sont les altitudes
+c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        les champs de sorties sont sur une grille physique:
+c             zmea:  orographie moyenne
+c             zstd:  deviation standard de l'orographie sous-maille
+c             zsig:  pente de l'orographie sous-maille 
+c             zgam:  anisotropy de l'orographie sous maille
+c             zthe:  orientation de l'axe oriente dans la direction
+c                    de plus grande pente de l'orographie sous maille
+C=======================================================================
+c     IMPLICIT INTEGER (I,J)
+c     IMPLICIT REAL(X,Z) 
+       implicit none
+       integer iusn,jusn,iext
+       parameter(iusn=360,jusn=180,iext=40)
+c!-*-      include 'param1'
+c!-*-      include 'comcstfi.h'
+#include "dimensions.h"
+#include "comconst.h"
+c!-*-
+c!-*-      parameter(iim=cols,jjm=rows)
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
+
+c   modif declarations pour implicit none
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
+      real zsigsud,zweinor,zweisud
+      real xk,xl,xm,xw,xp,xq
+      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
+      real zbordnor,zbordsud,zbordest,zbordoue,xpi
+      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
+      integer i,j,ii,jj,ideltax,ihalph
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL weight(iim+1,jjm+1)
+      REAL x(imar+1),y(jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+c  quelques constantes:
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      print*,'rad =',rad
+      print*,'Long et lat entree'
+      print*,(x(i),i=1,imar+1)
+      print*,(y(j),j=1,jmar)
+       print*,'Long et lat donnees'
+      print*,(xdata(i),i=1,imdep)
+      print*,(ydata(j),j=1,jmdep)
+
+      xpi=acos(-1.)
+      zdeltay=2.*xpi/real(jusn)*rad
+c
+c  quelques tests de dimensions:
+c    
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
+        print *,' imar ou jmar mal dimensionnes:',imar,jmar
+        call abort
+      ENDIF
+c
+C  Extension de la base de donnee de l'USN pour faciliter
+C  les calculs ulterieurs:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=entree(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=entree(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=entree(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c
+c  Calcul d'une orographie filtree aux hautes latitudes
+c  pour permettre des calculs plus isotropiques sur la pente
+c  des montagnes
+c
+       DO i=1,IUSN+2*iext
+       DO J=1,JUSN+2
+          zusnfi(i,j)=0.0
+       ENDDO
+       ENDDO
+
+      DO j=1,jusn
+            ideltax=1./cos(yusn(j+1))
+            ideltax=min(iusn/2-1,ideltax)
+            IF(MOD(IDELTAX,2).EQ.0)THEN
+              IDELTAX=IDELTAX+1
+            ENDIF
+            IHALPH=(IDELTAX-1)/2 
+c           print *,' ideltax=',ideltax
+         IF(ideltax.eq.1)THEN
+            DO i=1,iusn
+               zusnfi(i+iext,j+1)=entree(i,j)
+            ENDDO   
+         ELSE
+            DO i=1,ihalph
+               DO ii=1,i+ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               DO ii=ihalph-i,0,-1
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
+               ENDDO  
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO   
+            DO i=iusn-ihalph+1,iusn
+               DO ii = i-ihalph,iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO 
+               DO ii = 1,ihalph+i-iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO
+            DO i=ihalph+1,iusn-ihalph
+               DO ii=-ihalph,ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO
+         ENDIF
+            DO i=1,iext
+               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
+               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
+            ENDDO
+      ENDDO
+c  
+c Calculer les limites des zones des nouveaux points
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/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      quelques initialisations:
+      print*,'OKM1'
+c
+      DO i = 1, imar
+      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
+         zstd(i,j)=0.0
+      ENDDO
+      ENDDO
+c
+c  calculs des correlations de pentes sur la grille de l'USN.
+c
+         DO j = 2,jusn+1 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
+         ENDDO
+
+         ENDDO
+
+ 
+
+      print*,'OK0'
+c
+c  sommations des differentes quantites definies precedemment
+c  sur une grille du modele.
+c 
+      zleny=xpi/real(jusn)*rad
+      xincr=xpi/2./real(jusn)
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=amax1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=amax1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            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
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  calculs des differents parametres necessaires au programme
+c  de parametrisation de l'orographie a l'echelle moyenne:
+c
+      zmaxmea=0.
+      zmaxstd=0.
+      zmaxsig=0.
+      zmaxgam=0.
+      zmaxthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       print*,'OK1'
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c       print*,'ok0'
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Orography moyenne:
+c         print*,'ok1'
+           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         print*,'ok2'
+c  Deviation standard:
+           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+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          print*,'ok3'
+c pente: 
+           zsig(ii,jj)=sqrt(xq)
+c           zsig(ii,jj)=sqrt(2.*xk)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+
+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)     
+c          print*,'ok4'
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+c          print*,'ok1b'
+         ENDIF
+      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
+c         print*,'oka'
+      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
+c         print*,'okb'
+      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
+c         print*,'okc'
+      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
+c         print*,'okd'
+      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
+c         print*,'oke'
+      zminthe=amin1(zthe(ii,jj),zminthe)
+c      print*,'ok5'
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zmaxmea
+	  print *,'  ST. DEV.:',zmaxstd
+      print *,'  PENTE:',zmaxsig
+      print *,' ANISOTROP:',zmaxgam
+      print *,'  ANGLE:',zminthe,zmaxthe	
+      
+C
+c  On passe ce donnees sur la grille dite physique....(?)
+c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
+c  n'ont pas vraiment de sens
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(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
+
+      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)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/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
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F	(revision 1403)
@@ -0,0 +1,523 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,ith,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	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       ith            soil thermal inertia
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+ 
+      use comsoil_h, only: nsoilmx, mlayer
+      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(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      real ith(ip1jmp1,nsoilmx)
+      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 idim_nsoilmx ! "subsurface_layers" dimension ID #
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      tab_cntrl(1)  = REAL(iim) ! nombre de points en longitude
+      tab_cntrl(2)  = REAL(jjm) ! nombre de points en latitude
+      tab_cntrl(3)  = REAL(llm) ! nombre de couches
+      tab_cntrl(4)  = REAL(idayref) ! jour 0
+      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+      tab_cntrl(8)  = cpp 
+      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+      tab_cntrl(12) = etot0 ! energie totale    !
+      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+      tab_cntrl(16) = ang0 ! moment cinetique  !
+      tab_cntrl(17) = pa
+      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+       tab_cntrl(26) = 0.
+       IF ( ysinus)  tab_cntrl(26) = 1.
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau dynamique
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+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", 21,
+     &                       "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, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", 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-----------------------------------------------------------------------
+
+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,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#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  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c--------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+!---------------------
+! soil thermal inertia
+!---------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      dims3(1)=idim_rlonv
+      dims3(2)=idim_rlatu
+      dims3(3)=idim_nsoilmx
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     &                        "Soil thermal inertia")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
+     &                        "J.s-1/2.m-2.K-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
+#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
+
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
+      PRINT*,'daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,142 @@
+subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use dimphy, only : klev ! number of atmospheric levels
+use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
+                                       ! (on full grid)
+use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
+                               klon_omp_begin, & ! start index of local omp subgrid
+                               klon_omp_end, & ! end index of local omp subgrid
+                               klon_mpi_begin ! start indes of columns (on local mpi grid)
+
+use comgeomphy, only : initcomgeomphy, &
+                       airephy, & ! physics grid area (m2)
+                       cuphy, & ! cu coeff. (u_covariant = cu * u)
+                       cvphy, & ! cv coeff. (v_covariant = cv * v)
+                       rlond, & ! longitudes
+                       rlatd ! latitudes
+use infotrac, only : nqtot ! number of advected tracers
+use comgeomfi_h, only: ini_fillgeom
+
+implicit none
+
+include "iniprint.h"
+
+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 (full grid)
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
+integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
+real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
+real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
+real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
+real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: cv((ii+1)*jj) ! 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 :: ibegin,iend,offset
+integer :: i,j
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+real :: total_area_phy, total_area_dyn
+
+
+! global array, on full physics grid:
+real,allocatable :: latfi(:)
+real,allocatable :: lonfi(:)
+real,allocatable :: cufi(:)
+real,allocatable :: cvfi(:)
+real,allocatable :: airefi(:)
+
+IF (nlayer.NE.klev) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'nlayer     = ',nlayer
+  write(*,*) 'klev   = ',klev
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+!IF (ngrid.NE.klon_glo) THEN
+!  write(*,*) 'STOP in ',trim(modname)
+!  write(*,*) 'Problem with dimensions :'
+!  write(*,*) 'ngrid     = ',ngrid
+!  write(*,*) 'klon   = ',klon_glo
+!  abort_message = ''
+!  CALL abort_gcm (modname,abort_message,1)
+!ENDIF
+
+! Generate global arrays on full physics grid
+allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+latfi(1)=rlatu(1)
+lonfi(1)=0.
+cufi(1) = cu(1)
+cvfi(1) = cv(1)
+DO j=2,jj
+  DO i=1,ii
+    latfi((j-2)*ii+1+i)= rlatu(j)
+    lonfi((j-2)*ii+1+i)= rlonv(i)
+    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
+    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
+  ENDDO
+ENDDO
+latfi(klon_glo)= rlatu(jj+1)
+lonfi(klon_glo)= 0.
+cufi(klon_glo) = cu((ii+1)*jj+1)
+cvfi(klon_glo) = cv((ii+1)*jj-ii)
+
+! build airefi(), mesh area on physics grid
+allocate(airefi(klon_glo))
+CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
+! Poles are single points on physics grid
+airefi(1)=sum(aire(1:ii,1))
+airefi(klon_glo)=sum(aire(1:ii,jj+1))
+
+! Sanity check: do total planet area match between physics and dynamics?
+total_area_dyn=sum(aire(1:ii,1:jj+1))
+total_area_phy=sum(airefi(1:klon_glo))
+IF (total_area_dyn/=total_area_phy) THEN
+  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+    ! stop here if the relative difference is more than 0.001%
+    abort_message = 'planet total surface discrepancy'
+    CALL abort_gcm(modname, abort_message, 1)
+  ENDIF
+ENDIF
+
+
+
+!$OMP PARALLEL 
+! Now generate local lon/lat/cu/cv/area arrays
+call initcomgeomphy
+
+!!!!$OMP PARALLEL PRIVATE(ibegin,iend) 
+!!!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+offset=klon_mpi_begin-1
+airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call phys_state_var_init(klon_omp,nlayer,nqtot, &
+                         punjours,ptimestep,prad,pg,pr,pcpp)
+call ini_fillgeom(klon_omp,rlatd,rlond,airephy)
+call conf_phys(klon_omp,nlayer,nqtot)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F	(revision 1403)
@@ -0,0 +1,70 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
+     &             aps,bps,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**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (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
+
+c run
+c ====
+
+      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.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F	(revision 1403)
@@ -0,0 +1,1432 @@
+      SUBROUTINE lect_start_archive(ngrid,nlayer,nqtot,
+     &     date,tsurf,tsoil,emis,q2,
+     &     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,
+     &     q,qsurf,tauscaling,surfith,nid)
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+      use infotrac, only: tname
+      use comsoil_h, only: nsoilmx, layer, mlayer, volcapa, inertiedat
+      use planete_h
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "netcdf.inc"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+! routine arguments
+! -----------------
+      integer,intent(in) :: ngrid ! number of atmosphferic columns
+                                  ! on new physics grid
+      integer,intent(in) :: nlayer ! number of atmospheric layers
+                                   ! on new grid
+      integer,intent(in) :: nqtot ! number of advected tracers
+      REAL,INTENT(OUT) :: date
+      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
+      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
+      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
+      REAL,INTENT(OUT) :: co2ice(ngrid) ! CO2 ice layer
+      REAL,INTENT(OUT) :: emis(ngrid)
+      REAL,INTENT(OUT) :: q2(ngrid,nlayer+1),qsurf(ngrid,nqtot)
+      REAL,INTENT(OUT) :: tauscaling(ngrid) ! dust conversion factor
+      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
+      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
+      real,intent(in) :: surfith(iip1,jjp1) ! surface thermal inertia
+      INTEGER,INTENT(IN) :: nid ! input NetCDF file identifier
+
+
+
+c Old variables dimensions (from file)
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nsoilold,nqold
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+!      INTEGER sizei,
+      integer timelen,dimid
+!      INTEGER length
+!      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+!      CHARACTER*120 dimsource
+!      CHARACTER*16 dimname
+!      CHARACTER*80 dimtitle
+!      CHARACTER*40 dimunits
+!      INTEGER   dimtype
+
+!      INTEGER dimord(4)  ! tableau contenant l''ordre
+!      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+!      INTEGER vardim(4)
+      INTEGER   memo
+!      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL ::qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+!      integer klatdat,klongdat
+!      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+c     REAL phisfi(ngrid)
+
+      INTEGER i,j,l
+      INTEGER nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2),tauvis
+c     REAL iceradius(2) , dtemisice(2)
+
+!      EXTERNAL RAN1
+!      REAL RAN1
+!      EXTERNAL geopot,inigeom
+      integer ierr
+!      integer ismin
+!      external ismin
+!      CHARACTER*80 datapath
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real inertiedatS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
+      real tauscalingS(iip1,jjp1)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:), allocatable :: mlayerold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:,:),allocatable :: tsoiloldnew
+! tsoiloldnew: old soil values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatold
+! inertiedatoldnew: old inertia values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatoldnew
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold,tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+      real, dimension(:,:), allocatable :: tauscalingold
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+      logical :: olddepthdef=.false. ! flag
+! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
+      logical :: depthinterpol=.false. ! flag
+! depthinterpol=.true. if interpolation will be requiered
+      logical :: therminertia_3D=.true. ! flag
+! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+      real, dimension(:), allocatable :: oldgrid, oldval
+      real, dimension(:), allocatable :: newval
+!      real, dimension(:), allocatable :: oldmlayer
+
+!      real surfithfi(ngrid)
+      ! surface thermal inertia at old horizontal grid resolution
+      real, dimension(:,:), allocatable :: surfithold 
+
+! flag which identifies if archive file is using old tracer names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: counter
+      character(len=30) :: txt ! to store some text
+      real :: tmpval ! to store a temporary variable/value
+
+c=======================================================================
+
+! 0. Preliminary stuff
+
+! check if tracers follow old naming convention (q01, q02, q03, ...)
+      counter=0
+      do iq=1,nqtot
+        txt= " "
+        write(txt,'(a1,i2.2)')'q',iq
+        ierr=NF_INQ_VARID(nid,txt,nvarid)
+        if (ierr.ne.NF_NOERR) then
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          counter=counter+1
+        endif
+      enddo
+      if (counter.eq.nqtot) then
+        write(*,*) "lect_start_archive: tracers seem to follow old ",
+     &             "naming convention (q01, q02,...)"
+        oldtracernames=.true.
+      endif
+
+
+!-----------------------------------------------------------------------
+! 1. Read data dimensions (i.e. size and length)
+!-----------------------------------------------------------------------
+
+! 1.2 Read the various dimension lengths of data in file 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find Time length'
+        stop
+      else
+        write(*,*) "lect_start_archive: timelen=",timelen
+      endif
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find lat length'
+        stop
+      else
+        write(*,*) "lect_start_archive: jmold=",jmold
+      endif
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find lon length'
+        stop
+      else
+        write(*,*) "lect_start_archive: imold=",imold
+      endif
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find alt length'
+        stop
+      else
+        write(*,*) "lect_start_archive: lmold=",lmold
+      endif
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+! 1.2.1 find out the # of subsurface_layers
+      nsoilold=0 !dummy initialisation
+      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+      if (ierr.eq.NF_NOERR) then
+        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'lec_start_archive: ',
+     &              'Failed reading subsurface_layers length'
+	endif
+      else
+        write(*,*)"lec_start_archive: did not find subsurface_layers"
+      endif
+
+      if (nsoilold.eq.0) then ! 'old' archive format;
+      ! must use Tg//str2 fields to compute nsoilold
+      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
+        do
+	 write(str2,'(i2.2)') nsoilold+1
+	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
+	 if (ierr.eq.NF_NOERR) then
+	  nsoilold=nsoilold+1
+	 else
+	  exit
+	 endif
+	enddo
+      endif
+
+
+      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
+        depthinterpol=.true.
+      endif
+
+! 1.3 Report dimensions
+      
+      write(*,*) "lect_start_archive: Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      if (nqold.gt.0) then
+        write(*,*) "old tracers q*: ",nqold
+      endif
+      write(*,*) "subsurface_layers: ",nsoilold
+      if (depthinterpol) then
+      write(*,*) " => Warning, nsoilmx= ",nsoilmx
+      write(*,*) '    which implies that you want subterranean interpola
+     &tion.'
+      write(*,*) '  Otherwise, set nsoilmx -in comsoil_h- to: ',nsoilold
+      endif
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+!-----------------------------------------------------------------------
+! 2. Allocate arrays to store datasets
+!-----------------------------------------------------------------------
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqtot))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(tsoilold(imold+1,jmold+1,nsoilold))
+      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
+      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
+      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
+      ! surface thermal inertia at old horizontal grid resolution
+      allocate(surfithold(imold+1,jmold+1))
+      allocate(mlayerold(nsoilold))
+      allocate(qsurfold(imold+1,jmold+1,nqtot))
+      allocate(tauscalingold(imold+1,jmold+1))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngrid,nlayer+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+
+!-----------------------------------------------------------------------
+! 3. Read time-independent data
+!-----------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+c 3.1. Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: <controle> is missing"
+         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*, "lect_start_archive: Failed loading <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c 3.2 Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlonv> is missing"
+         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*, "lect_start_archive: Failed loading <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlatu> is missing"
+         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*, "lect_start_archive: Failed loading <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlonu> is missing"
+         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*, "lect_start_archive: Failed loading <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlatv> is missing"
+         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*, "lect_start_archive: Failed loading <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c 3.3. Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <aps> is missing"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Failed loading <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <bps> is missing"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <bps>"
+         CALL abort
+      END IF
+
+c-----------------------------------------------------------------------
+c 3.4 Read Soil layers depths
+c-----------------------------------------------------------------------
+     
+      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <soildepth>'
+       write(*,*)' => Assuming this is an archive in old format'
+       olddepthdef=.true.
+       depthinterpol=.true.
+       ! this is how soil depth was defined in ye old days
+	do isoil=1,nsoilold
+	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
+	enddo
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+
+      endif !of if(ierr.ne.NF_NOERR)
+
+      ! Read (or build) mlayer()
+      if (depthinterpol) then
+       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
+       ! as in soil_settings.F
+       write(*,*)' => Building default soil depths'
+       do isoil=0,nsoilmx-1
+         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
+       enddo
+       write(*,*)' => mlayer: ',mlayer
+       ! Also build (default) new soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+       write(*,*)' =>  layer: ',layer
+      else ! read mlayer() from file
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+       ! Also build (default) soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+      endif ! of if (depthinterpol)
+
+c-----------------------------------------------------------------------
+c 3.5 Read Soil thermal inertia
+c-----------------------------------------------------------------------
+
+      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <inertiedat>'
+       write(*,*)' => Assuming this is an archive in old format'
+       therminertia_3D=.false.
+       write(*,*)' => Thermal inertia will be read from reference file'
+       volcapa=1.e6
+       write(*,*)'    and soil volumetric heat capacity is set to ',
+     &           volcapa
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
+         CALL abort
+       endif
+      endif
+
+c-----------------------------------------------------------------------
+c 3.6 Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <phisinit> is missing"
+         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*, "lect_start_archive: Failed loading <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c 4. Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: <Time> is missing"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Dates of the stored initial states:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+c        write(*,*) 'initial state at martian day: ',int(timelist(i))
+        write(*,*) 'initial state at martian day: ',timelist(i)
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choose the martian day to use'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+c        if (date.eq.int(timelist(i))) then
+        if (abs(date-timelist(i)).lt.0.01) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'Wrong value for day number !!'
+        write(*,*)
+        write(*,*) 'Dates of the stored initial states:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'initial state at martian day: ',timelist(i)
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+      
+!-----------------------------------------------------------------------
+! 5. Read (time-dependent) data from datafile
+!-----------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf, tauscaling)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <co2ice> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <co2ice>"
+         PRINT*, NF_STRERROR(ierr)
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <emis> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <emis>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <ps> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <tsurf> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <tsurf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <q2surf> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <q2surf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tauscaling", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <tauscaling> not in file"
+         tauscalingold(:,:) = -1
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tauscalingold)
+#else
+        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tauscalingold)
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+           PRINT*, "lect_start_archive: Failed loading <tauscaling>"
+           PRINT*, NF_STRERROR(ierr)
+           CALL abort
+        ENDIF
+      ENDIF
+c
+      write(*,*)"lect_start_archive: rlonuold:"
+     &           ,rlonuold," rlatvold:",rlatvold
+      write(*,*)
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Surface tracers:      
+      qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0
+
+      DO iq=1,nqtot
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a5,i2.2)')'qsurf',iq
+        ELSE
+          txt=trim(tname(iq))//"_surf"
+          if (txt.eq."h2o_vap") then
+            ! There is no surface tracer for h2o_vap;
+            ! "h2o_ice" should be loaded instead
+            txt="h2o_ice_surf"
+            write(*,*) 'lect_start_archive: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+          endif
+        ENDIF ! of IF (oldtracernames)
+        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+          print*, "which (constant) value should it be initialized to?"
+          read(*,*) tmpval
+          qsurfold(1:imold+1,1:jmold+1,iq)=tmpval
+        ELSE ! tracer exists in file, load it
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#endif
+          IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &             " Failed loading <",trim(txt),">"
+            stop
+          ENDIF
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+!-----------------------------------------------------------------------
+! 5.2 Read 3D subterranean fields
+!-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+!
+! Read soil temperatures
+!
+      if (olddepthdef) then ! tsoil stored using the 'old format'
+         start=(/1,1,memo,0/)
+         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
+       do isoil=1,nsoilold
+!        write(*,*)'isoil',isoil
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              "Field <","Tg"//str2,"> not found"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &            "Failed reading <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+       enddo ! of do isoil=1,nsoilold
+      
+      ! reset 'start' and 'count' to "3D" behaviour
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+      
+      else
+       write(*,*) "lect_start_archive: loading tsoil "
+       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+       if (ierr.ne.NF_NOERR) then
+        write(*,*)"lect_start_archive: Cannot find <tsoil>"
+	call abort
+       else
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
+#endif
+       endif ! of if (ierr.ne.NF_NOERR)
+       
+      endif ! of if (olddepthdef)
+
+!
+! Read soil thermal inertias
+!
+!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
+!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
+!	call abort
+!       else
+!#ifdef NC_DOUBLE
+!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
+!#else
+!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
+!#endif
+!       endif ! of if (ierr.ne.NF_NOERR)
+!      endif
+
+c-----------------------------------------------------------------------
+c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,lmold,1/)
+
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <temp> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <u> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <v> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <q2atm> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Tracers:
+      qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0
+
+      DO iq=1,nqtot
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a1,i2.2)')'q',iq
+        ELSE
+          txt=tname(iq)
+        ENDIF
+        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+          print*, "which (constant) value should it be initialized to?"
+          read(*,*) tmpval
+          qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval
+        ELSE ! tracer exists in file, load it
+#ifdef NC_DOUBLE
+         ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+         ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+          IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &             "  Failed loading <",trim(txt),">"
+            stop
+          ENDIF
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
+c -------------------------------------------------------------------------
+
+!      datapath = '/users/forget/gcm/data_mars_gcm'
+
+
+!=======================================================================
+! 6. Interpolation from old grid to new grid
+!=======================================================================
+
+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 6.1	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Glace CO2
+      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,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,iim+1,jjm+1,ngrid,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
+
+c Dust conversion factor
+      call interp_horiz (tauscalingold,tauscalings,imold,jmold,iim,jjm,
+     &                   1,rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tauscalings,tauscaling)
+c     write(46,*) 'emis',emis
+c-----------------------------------------------------------------------
+c 6.1.2	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-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+         END DO
+      END DO
+
+      write(*,*)
+      write(*,*)'Old grid: mass of the atmosphere :',ptotalold
+      write(*,*)'New grid: mass of the atmosphere :',ptotal
+      write (*,*) 'Ratio new atm / old atm =', ptotal/ptotalold 
+      write(*,*)
+      write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold
+      write(*,*)'New grid: mass of CO2 ice:',co2icetotal
+      if (co2icetotalold.ne.0.) then
+       write(*,*)'Ratio new ice / old ice =',co2icetotal/co2icetotalold
+      endif
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+         DO j=1,jjp1
+            DO i=1,iip1
+               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+            END DO
+         END DO
+      end if
+
+c-----------------------------------------------------------------------
+c 6.2 Subterranean 3d variables:
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c 6.2.1 Thermal Inertia
+c       Note: recall that inertiedat is a common in "comsoil.h"
+c-----------------------------------------------------------------------
+
+      ! depth-wise interpolation, if required
+      if (depthinterpol.and.(.not.olddepthdef)) then
+        allocate(oldval(nsoilold))
+	allocate(newval(nsoilmx))
+        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
+     &f soil thermal inertia; might be wiser to reset it.'
+        write(*,*)
+       
+        do i=1,imold+1
+         do j=1,jmold+1
+	   !copy old values
+	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
+	   !interpolate
+	   call interp_line(mlayerold,oldval,nsoilold,
+     &                     mlayer,newval,nsoilmx)
+           !copy interpolated values
+           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+        enddo
+        ! cleanup
+	deallocate(oldval)
+	deallocate(newval)
+      endif !of if (depthinterpol)
+
+      if (therminertia_3D) then
+        ! We have inertiedatold
+       if((imold.ne.iim).or.(jmold.ne.jjm)) then
+       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
+     &of thermal inertia; might be better to reset it.'
+       write(*,*)
+       endif
+       
+        ! Do horizontal interpolation
+	if (depthinterpol) then
+	  call interp_horiz(inertiedatoldnew,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+	else
+          call interp_horiz(inertiedatold,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilold,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+        endif ! of if (depthinterpol)
+
+      else ! no 3D thermal inertia data
+       write(*,*)'lect_start_archive: using reference surface inertia'
+        ! Use surface inertia (and extend it to all depths)
+        do i=1,nsoilmx
+         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
+        enddo
+	! Build an old resolution surface thermal inertia
+	! (will be needed for tsoil interpolation)
+	call interp_horiz(surfith,surfithold,
+     &                    iim,jjm,imold,jmold,1,
+     &                    rlonu,rlatv,rlonuold,rlatvold)
+      endif
+
+
+      ! Reshape inertiedatS to scalar grid as inertiedat
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
+     &                  inertiedatS,inertiedat)
+      
+c-----------------------------------------------------------------------
+c 6.2.2 Soil temperature
+c-----------------------------------------------------------------------
+!      write(*,*) 'Soil'
+      ! Recast temperatures along soil depth, if necessary
+      if (olddepthdef) then
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	   ! build vertical coordinate
+	   oldgrid(1)=0. ! ground
+	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
+     &                (surfithold(i,j)/1.e6)
+          ! Note; at this stage, we impose volcapa=1.e6 above
+	  ! since volcapa isn't set in old soil definitions
+
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+
+      else
+       if (depthinterpol) then ! if vertical interpolation is required
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        ! build vertical coordinate
+	oldgrid(1)=0. ! ground
+	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+       
+       else
+        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
+       endif ! of if (depthinterpol)
+      endif ! of if (olddepthdef)
+
+      ! Do the horizontal interpolation
+       call interp_horiz(tsoiloldnew,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+      ! Reshape tsoilS to scalar grid as tsoil
+       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
+
+
+
+c-----------------------------------------------------------------------
+c 6.3 Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
+      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,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 (*,*) 'lect_start_archive: unat ', unat (1,1,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)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'lect_start_archive: ucov ', ucov (1,1,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)
+c           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 traceurs surface
+      do iq = 1, nqtot
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqtot
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+c      iqmax=1
+c      
+c      if (nqold.gt.10) then
+c       do l=1,llm
+c        do j=1,jjp1
+c          do i=1,iip1
+c           do iq=1,nqold
+c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+c              iqmax=iq
+c            endif
+c           enddo
+c           q(i,j,l,iqmax)=1.
+c           qtot(i,j,l)=0
+c           do iq=1,nqold
+c            if (iq.ne.iqmax) then        
+c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+c            endif
+c           enddo !iq
+c           do iq=1,nqold
+c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+c           enddo !iq
+c          enddo !i   
+c         enddo !j   
+c       enddo !l  
+c      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqtot
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(tsoiloldnew)
+      deallocate(inertiedatold)
+      deallocate(inertiedatoldnew)
+      deallocate(surfithold)
+      deallocate(mlayerold)
+      deallocate(qsurfold)
+      deallocate(tauscalingold)
+      deallocate(var,varp1)
+
+!      write(*,*)'lect_start_archive: END'
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F	(revision 1403)
@@ -0,0 +1,1781 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      use ioipsl_getincom, only: getin 
+      use infotrac, only: iniadvtrac, nqtot, tname
+      use tracer_mod, only: noms, mmol,
+     &                      igcm_dust_number, igcm_dust_mass,
+     &                      igcm_ccn_number, igcm_ccn_mass,
+     &                      igcm_h2o_vap, igcm_h2o_ice, igcm_co2,
+     &                      igcm_n2, igcm_ar, igcm_o2, igcm_co
+      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
+     &                     albedodat, z0_default, qsurf, tsurf,
+     &                     co2ice, emis
+      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx, tsoil
+      use control_mod, only: day_step, iphysiq, anneeref
+      use phyredem, only: physdem0, physdem1
+      use iostart, only: open_startphy
+      use comgeomphy, only: initcomgeomphy
+!      use planete_h
+      use dimradmars_mod, only: tauscaling
+      use turb_mod, only: q2
+      use comgeomfi_h, only: ini_fillgeom
+      use filtreg_mod, only: inifilr
+
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+#include "serre.h"
+#include "netcdf.inc"
+#include "datafile.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+c et autres:
+c----------
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+      INTEGER tab0
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+      real z0S(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tauscadyn(iip1,jjp1) ! dust conversion factor on the dynamics grid
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      integer ierr  !, nbetat
+
+c Variables on the new grid along scalar points 
+c------------------------------------------------------
+!      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+!      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1 ! ==0 : read start_archive file ; ==1: read start files
+      character*80      fichnom
+      integer Lmodif,iq
+      integer flagthermo, flagh2o
+      character modif*20
+      real tsud,albsud,alb_bb,ith_bb,Tiso
+      real ptoto,pcap,patm,airetot,ptotn,patmn
+!      real ssum
+      character*1 yes
+      logical :: flagiso=.false. ,  flagps0=.false.
+      real val, val2, val3 ! to store temporary variables
+      real :: iceith=2000 ! thermal inertia of subterranean ice
+      real :: iceithN,iceithS ! values of thermal inertias in N & S hemispheres
+      integer iref,jref
+
+      INTEGER :: itau
+      
+      INTEGER :: numvanle
+      character(len=50) :: txt ! to store some text
+      integer :: count
+      real :: profile(llm+1) ! to store an atmospheric profile + surface value
+
+! MONS data:
+      real :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! coefficient to apply to convert d21 to 'true' depth (m)
+      real :: MONS_coeff
+      real :: MONS_coeffS ! coeff for southern hemisphere
+      real :: MONS_coeffN ! coeff for northern hemisphere
+!      real,parameter :: icedepthmin=1.e-3 ! Ice begins at most at that depth
+! Reference position for composition
+      real :: latref,lonref,dlatmin,dlonmin
+! Variable used to change composition
+      real :: Svmr,Smmr,Smmr_old,Smmr_new,Sn
+      real :: Mair_old,Mair_new,vmr_old,vmr_new
+      real,allocatable :: coefvmr(:)  ! Correction coefficient when changing composition
+      integer :: iloc(1), iqmax
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+!      INTEGER :: visuid
+!      real :: time_step,t_ops,t_wrt
+!      CHARACTER*80 :: visu_file
+
+      cpp    = 744.499 ! for Mars, instead of 1004.70885 (Earth)
+      preff  = 610.    ! for Mars, instead of 101325. (Earth)
+      pa= 20           ! for Mars, instead of 500 (Earth)
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+! allocate arrays
+      allocate(q(iip1,jjp1,llm,nqtot))
+      allocate(coefvmr(nqtot))
+
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'reading 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
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'reading tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'reading tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+      write(*,*) 'printing tab_cntrl', tab_cntrl
+      do i=1,100
+        write(*,*) i,tab_cntrl(i)
+      enddo
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         ! tabfi requires that input file be first opened by open_startphy(fichnom)
+         fichnom = 'start_archive.nc'
+         call open_startphy(fichnom)
+         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         fichnom = 'startfi.nc'
+         call open_startphy(fichnom)
+         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      mugaz = p_mugaz
+      daysec = p_daysec
+!      write(*,*) 'aire',aire
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+      day_step=180 !?! Note: day_step is a common in "control.h"
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
+!       rlatu() and rlonv() are given in radians
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+      
+      ! build airefi(), mesh area on physics grid
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+      ! Poles are single points on physics grid
+      airefi(1)=sum(aire(1:iim,1))
+      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
+
+! also initialize various physics flags/settings which might be needed
+!    (for instance initracer needs to know about some flags, and/or
+!      'datafile' path may be changed by user)
+      call phys_state_var_init(ngridmx,llm,nqtot,
+     .                         daysec,dtphys,rad,g,r,cpp)
+      call ini_fillgeom(ngridmx,latfi,lonfi,airefi)
+      call conf_phys(ngridmx,llm,nqtot)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
+                              ! surface.dat dans le cas des start
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+      CALL datareadnc(relief,phis,alb,surfith,z0S,
+     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
+
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+!      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,z0S,z0)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif ! of if (choix_1.ne.1)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Reading file START_ARCHIVE'
+        CALL lect_start_archive(ngridmx,llm,nqtot,
+     &   date,tsurf,tsoil,emis,q2,
+     &   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,
+     &   tauscaling,surfith,nid)
+        write(*,*) "OK, read start_archive file"
+	! copy soil thermal inertia
+	ithfi(:,:)=inertiedat(:,:)
+	
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
+                                  !  permet de changer les valeurs du 
+                                  !  tab_cntrl Lmodif=1
+        tab0=0
+        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+        write(*,*) 'Reading file START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'Reading file STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
+     .        day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
+        
+        ! copy albedo and soil thermal inertia
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+	  do j=1,nsoilmx
+           ithfi(i,j) = inertiedat(i,j)
+	  enddo
+        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
+        ! be neede later on if reinitializing soil thermal inertia
+          surfithfi(i)=ithfi(i,1)
+        enddo
+
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/REAL(day_step)
+      dtphys   = dtvr * REAL(iphysiq)
+
+c=======================================================================
+c 
+c=======================================================================
+! If tracer names follow 'old' convention (q01, q02, ...) then
+! rename them
+      count=0
+      do iq=1,nqtot
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tname(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqtot
+      
+      ! initialize tracer names noms(:) and indexes (igcm_co2, igcm_h2o_vap, ...)
+      call initracer(ngridmx,nqtot,qsurf)
+      
+      if (count.eq.nqtot) then
+        write(*,*) 'Newstart: updating tracer names'
+        ! copy noms(:) to tname(:) to have matching tracer names in physics
+        ! and dynamics
+        tname(1:nqtot)=noms(1:nqtot)
+      endif
+
+c=======================================================================
+c 
+c=======================================================================
+
+      do ! infinite loop on list of changes
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'List of possible changes :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat         : no topography ("aquaplanet")'
+      write(*,*) 'bilball      : uniform albedo and thermal inertia'
+      write(*,*) 'z0           : set a uniform surface roughness length'
+      write(*,*) 'coldspole    : cold subsurface and high albedo at
+     $ S.Pole'
+      write(*,*) 'qname        : change tracer name'
+      write(*,*) 'q=0          : ALL tracer =zero'
+      write(*,*) 'q=x          : give a specific uniform value to one
+     $ tracer'
+      write(*,*) 'q=profile    : specify a profile for a tracer'
+      write(*,*) 'freedust     : rescale dust to a true value'
+      write(*,*) 'ini_q        : tracers initialization for chemistry
+     $ and water vapour'
+      write(*,*) 'ini_q-h2o    : tracers initialization for chemistry
+     $ only'
+      write(*,*) 'composition  : change atm main composition: CO2,N2,Ar,
+     $ O2,CO'
+      write(*,*) 'ini_h2osurf  : reinitialize surface water ice '
+      write(*,*) 'noglacier    : Remove tropical H2O ice if |lat|<45'
+      write(*,*) 'watercapn    : H20 ice on permanent N polar cap '
+      write(*,*) 'watercaps    : H20 ice on permanent S polar cap '
+      write(*,*) 'wetstart     : start with a wet atmosphere'
+      write(*,*) 'isotherm     : Isothermal Temperatures, wind set to
+     $ zero'
+      write(*,*) 'co2ice=0     : remove CO2 polar cap'
+      write(*,*) 'ptot         : change total pressure'
+      write(*,*) 'therm_ini_s  : set soil thermal inertia to reference
+     $ surface values'
+      write(*,*) 'subsoilice_n : put deep underground ice layer in
+     $ northern hemisphere'
+      write(*,*) 'subsoilice_s : put deep underground ice layer in
+     $ southern hemisphere'
+      write(*,*) 'mons_ice     : put underground ice layer according
+     $ to MONS derived data'
+
+        write(*,*)
+        write(*,*) 'Change to perform ?'
+        write(*,*) '   (enter keyword or return to end)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') exit ! exit loop on changes
+
+        write(*,*)
+        write(*,*) trim(modif) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (trim(modif) .eq. 'flat') then
+c         set topo to zero 
+          phis(:,:)=0
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+
+c        Choice for surface pressure
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to choose homogeneous surface',
+     &                 'pressure (y) or let newstart interpolate ',
+     &                 ' the previous field  (n)?'
+             read(*,fmt='(a)') yes
+         end do
+         if (yes.eq.'y') then
+           flagps0=.true.
+           write(*,*) 'New value for ps (Pa) ?'
+ 201       read(*,*,iostat=ierr) patm
+            if(ierr.ne.0) goto 201
+             write(*,*)
+             write(*,*) ' new ps everywhere (Pa) = ', patm
+             write(*,*)
+             do j=1,jjp1
+               do i=1,iip1
+                 ps(i,j)=patm
+               enddo
+             enddo
+         end if
+
+c       bilball : albedo, inertie thermique uniforme
+c       --------------------------------------------
+        else if (trim(modif) .eq. 'bilball') then
+          write(*,*) 'constante albedo and iner.therm:'
+          write(*,*) 'New value for albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' uniform albedo (new value):',alb_bb
+          write(*,*)
+
+          write(*,*) 'New value for thermal inertia (eg: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'uniform thermal inertia (new value):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb	! albedo
+		do isoil=1,nsoilmx
+                  ith(i,j,isoil) = ith_bb	! thermal inertia
+		enddo
+             END DO
+          END DO
+!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+        
+         ! also reset surface roughness length to default value
+         write(*,*) 'surface roughness length set to:',z0_default,' m'
+         z0(:)=z0_default
+
+!       z0 : set surface roughness length to a constant value
+!       -----------------------------------------------------
+        else if (trim(modif) .eq. 'z0') then
+          write(*,*) 'set a uniform surface roughness length'
+          write(*,*) ' value for z0_default (ex: ',z0_default,')?'
+          ierr=1
+          do while (ierr.ne.0)
+            read(*,*,iostat=ierr) z0_default
+          enddo
+          z0(:)=z0_default
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (trim(modif) .eq. 'coldspole') then
+          write(*,*)'new value for the subsurface temperature',
+     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' new value of the subsurface temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'new value for the albedo',
+     &   'of the permanent southern polar cap ? (eg: 0.75)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  only the albedo of the pole is modified :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification of the total pressure: ice + current atmosphere 
+c       -------------------------------------------------------------------
+        else if (trim(modif) .eq. 'ptot') then
+
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                pcap = pcap + aire(i,j)*co2ice(ig)*g
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Current total pressure at surface (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'new value?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Mult. factor for pressure (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c       qname : change tracer name
+c       --------------------------
+        else if (trim(modif).eq.'qname') then
+         yes='y'
+         do while (yes.eq.'y')
+          write(*,*) 'Which tracer name do you want to change ?'
+          do iq=1,nqtot
+            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
+          enddo
+          write(*,'(a35,i3)')
+     &            '(enter tracer number; between 1 and ',nqtot
+          write(*,*)' or any other value to quit this option)'
+          read(*,*) iq
+          if ((iq.ge.1).and.(iq.le.nqtot)) then
+            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
+            read(*,*) txt
+            tname(iq)=txt
+            write(*,*)'Do you want to change another tracer name (y/n)?'
+            read(*,'(a)') yes 
+          else
+! inapropiate value of iq; quit this option
+            yes='n'
+          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
+         enddo ! of do while (yes.ne.'y')
+
+c       q=0 : set tracers to zero
+c       -------------------------
+        else if (trim(modif) .eq. 'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          set surface tracers to zero
+           DO iq =1, nqtot
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (trim(modif) .eq. 'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
+     &                 ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
+     &                   ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       q=profile : initialize tracer with a given profile
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'q=profile') then
+             write(*,*) 'Tracer profile will be sought in ASCII file'
+             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             write(*,*) 'Which tracer do you want to set?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             ! look for input file 'profile_tracer'
+             txt="profile_"//trim(tname(iq))
+             open(41,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(41,*,iostat=ierr) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 ! initialize tracer values
+                 qsurf(:,iq)=profile(1)
+                 do l=1,llm
+                   q(:,:,l,iq)=profile(l+1)
+                 enddo
+                 write(*,*)'OK, tracer ',trim(tname(iq)),
+     &               ' initialized ','using values from file ',trim(txt)
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to tracer ',trim(tname(iq))
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to tracer ',trim(tname(iq))
+             endif
+             
+c       convert dust from virtual to true values
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'freedust') then
+         if (minval(tauscaling) .lt. 0) then
+           write(*,*) 'WARNING conversion factor negative'
+           write(*,*) 'This is probably because it was not present
+     &in the file'
+           write(*,*) 'A constant conversion is used instead.'
+           tauscaling(:) = 1.e-3
+         endif
+         CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscadyn)
+          do l=1,llm
+            do j=1,jjp1
+              do i=1,iip1
+                if (igcm_dust_number .ne. 0) 
+     &            q(i,j,l,igcm_dust_number) =
+     &            q(i,j,l,igcm_dust_number) * tauscadyn(i,j)
+                if (igcm_dust_mass .ne. 0) 
+     &            q(i,j,l,igcm_dust_mass) =
+     &            q(i,j,l,igcm_dust_mass) * tauscadyn(i,j)
+                if (igcm_ccn_number .ne. 0) 
+     &            q(i,j,l,igcm_ccn_number) =
+     &            q(i,j,l,igcm_ccn_number) * tauscadyn(i,j)
+                if (igcm_ccn_mass .ne. 0) 
+     &            q(i,j,l,igcm_ccn_mass) =
+     &            q(i,j,l,igcm_ccn_mass) * tauscadyn(i,j)
+              end do
+            end do
+          end do
+
+          tauscaling(:) = 1.
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'done rescaling to true vale'
+
+c       ini_q : Initialize tracers for chemistry
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'ini_q') then
+          flagh2o    = 1
+          flagthermo = 0
+          yes=' '
+c         For more than 32 layers, possible to initiate thermosphere only     
+          if (llm.gt.32) then 
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &     'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then
+            flagthermo=1 
+            else
+            flagthermo=0
+            endif
+            enddo  
+          endif
+          
+          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
+     &                          flagh2o, flagthermo)
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'inichim_newstart: chemical species and
+     $ water vapour initialised'
+
+c       ini_q-h2o : as above except for the water vapour tracer 
+c       ------------------------------------------------------
+        else if (trim(modif) .eq. 'ini_q-h2o') then
+          flagh2o    = 0
+          flagthermo = 0
+          yes=' '
+          ! for more than 32 layers, possible to initiate thermosphere only     
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            flagthermo=1 
+            else
+            flagthermo=0
+            endif
+            enddo
+          endif
+
+          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
+     &                          flagh2o, flagthermo)
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'inichim_newstart: chemical species initialised
+     $ (except water vapour)'
+
+c      composition : change main composition: CO2,N2,Ar,O2,CO (FF 03/2014)
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'composition') then
+          write(*,*) "Lat (degN)  lon (degE) of the reference site ?"
+          write(*,*) "e.g. MSL : -4.5  137.  "
+ 301      read(*,*,iostat=ierr) latref, lonref
+          if(ierr.ne.0) goto 301
+
+
+        !  Select GCM point close to reference site
+          dlonmin =90.
+          DO i=1,iip1-1
+             if (abs(rlonv(i)*180./pi -lonref).lt.dlonmin)then
+                iref=i
+                dlonmin=abs(rlonv(i)*180./pi -lonref)
+             end if   
+          ENDDO
+          dlatmin =45.
+          DO j=1,jjp1
+             if (abs(rlatu(j)*180./pi -latref).lt.dlatmin)then
+                jref=j
+                dlatmin=abs(rlatu(j)*180./pi -latref)
+             end if   
+          ENDDO
+          write(*,*) "In GCM : lat= " ,  rlatu(jref)*180./pi
+          write(*,*) "In GCM : lon= " ,  rlonv(iref)*180./pi
+          write(*,*)
+
+        ! Compute air molar mass at reference site
+          Smmr=0
+          Sn = 0
+          do iq=1,nqtot 
+             if ((iq.eq.igcm_co2).or.(iq.eq.igcm_n2)
+     &      .or. (iq.eq.igcm_ar).or.(iq.eq.igcm_o2)
+     &      .or. (iq.eq.igcm_co)) then
+                 Smmr=Smmr+q(iref,jref,1,iq)
+                 Sn=Sn+q(iref,jref,1,iq)/mmol(iq) 
+             end if
+          end do
+          write(*,*) "At reference site :  "
+          write(*,*) "Sum of mass mix. ratio (should be about 1)=",Smmr
+          Mair_old =Smmr/Sn
+          write(*,*)
+     &     "Air molar mass (g/mol) at reference site= ",Mair_old
+
+        ! Ask for new volume mixing ratio at reference site
+          Svmr =0.
+          Sn =0.
+          do iq=1,nqtot 
+           coefvmr(iq) = 1.
+           if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &     .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+
+             vmr_old=q(iref,jref,1,iq)*Mair_old/mmol(iq)  
+             write(*,*) "Previous vmr("//trim(tname(iq))//")= ", vmr_old
+
+              if (iq.eq.igcm_n2) then
+                write(*,*) "New vmr(n2)? (MSL: 2.03e-02 at Ls~184)"
+              endif
+              if (iq.eq.igcm_ar) then
+                write(*,*) "New vmr(ar)? (MSL: 2.07e-02 at Ls~184)"
+              endif
+              if (iq.eq.igcm_o2) then
+                write(*,*) "New vmr(o2)? (MSL: 1.73e-03 at Ls~184)"
+              endif
+              if (iq.eq.igcm_co) then
+                write(*,*) "New vmr(co)? (MSL: 7.49e-04 at Ls~184)"
+              endif
+ 302          read(*,*,iostat=ierr) vmr_new
+              if(ierr.ne.0) goto 302
+              write(*,*) "New vmr("//trim(tname(iq))//")= ",vmr_new
+              write(*,*) 
+              coefvmr(iq) = vmr_new/vmr_old
+              Svmr=Svmr+vmr_new
+              Sn=Sn+vmr_new*mmol(iq)
+           end if
+          enddo ! of do iq=1,nqtot 
+      !  Estimation of new Air molar mass at reference site (assuming vmr_co2 = 1-Svmr)
+          Mair_new = Sn + (1-Svmr)*mmol(igcm_co2) 
+          write(*,*)
+     &     "NEW Air molar mass (g/mol) at reference site= ",Mair_new
+
+        ! Compute mass mixing ratio changes  
+          do iq=1,nqtot  
+            if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &          .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+             write(*,*) "Everywhere mmr("//trim(tname(iq))//
+     &        ") is multiplied by ",coefvmr(iq)*Mair_old/Mair_new
+            end if
+          end do
+
+        ! Recompute mass mixing ratios everywhere, and adjust mmr of most abundant species
+        ! to keep sum of mmr constant.
+          do l=1,llm
+           do j=1,jjp1
+            do i=1,iip1
+              Smmr_old = 0.
+              Smmr_new = 0.
+              do iq=1,nqtot  
+                if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &         .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+                   Smmr_old = Smmr_old + q(i,j,l,iq) ! sum of old mmr 
+                   q(i,j,l,iq)=q(i,j,l,iq)*coefvmr(iq)*Mair_old/Mair_new
+                   Smmr_new = Smmr_new + q(i,j,l,iq) ! sum of new mmr
+                end if 
+              enddo
+              iloc = maxloc(q(i,j,l,:))
+              iqmax = iloc(1)
+              q(i,j,l,iqmax) = q(i,j,l,iqmax) + Smmr_old - Smmr_new
+            enddo
+           enddo
+          enddo
+
+          write(*,*)
+     &   "The most abundant species is modified everywhere to keep "//
+     &   "sum of mmr constant"
+          write(*,*) 'At reference site vmr(CO2)=', 
+     &        q(iref,jref,1,igcm_co2)*Mair_new/mmol(igcm_co2)
+          write(*,*) "Compared to MSL observation: vmr(CO2)= 0.957 "//
+     &   "at Ls=184" 
+
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'wetstart') then
+        ! check that there is indeed a water vapor tracer
+        if (igcm_h2o_vap.eq.0) then
+          write(*,*) "No water vapour tracer! Can't use this option"
+          stop
+        endif
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1-1
+                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+              ! We want to have the very same value at lon -180 and lon 180
+              q(iip1,j,l,igcm_h2o_vap) = q(1,j,l,igcm_h2o_vap)
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,igcm_h2o_vap)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,igcm_h2o_vap)
+
+c      ini_h2osurf : reinitialize surface water ice
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'ini_h2osurf') then
+          write(*,*)'max surface ice left?(e.g. 0.2 kg/m2=200microns)'
+ 207      read(*,*,iostat=ierr) val
+          if(ierr.ne.0) goto 207
+          write(*,*)'also set negative values of surf ice to 0'
+           do ig=1,ngridmx
+              qsurf(ig,igcm_h2o_ice)=min(val,qsurf(ig,igcm_h2o_ice))
+              qsurf(ig,igcm_h2o_ice)=max(0.,qsurf(ig,igcm_h2o_ice))
+           end do
+
+c      noglacier : remove tropical water ice (to initialize high res sim)
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'noglacier') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              write(*,*) 'OK: remove surface ice for |lat|<45'
+              if (abs(rlatu(j)*180./pi).lt.45.) then
+                   qsurf(ig,igcm_h2o_ice)=0.
+              end if
+           end do
+
+
+c      watercapn : H20 ice on permanent northern cap
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'watercapn') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              if (rlatu(j)*180./pi.gt.80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &              rlatv(j)*180./pi
+                end if
+           enddo
+
+c      watercaps : H20 ice on permanent southern cap
+c      -------------------------------------------------
+        else if (trim(modif) .eq. 'watercaps') then
+           do ig=1,ngridmx
+               j=(ig-2)/iim +2
+               if(ig.eq.1) j=1
+               if (rlatu(j)*180./pi.lt.-80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &              rlatv(j-1)*180./pi
+               end if
+           enddo
+
+c       isotherm : Isothermal temperatures and no winds
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of this temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          do ig=1, ngridmx
+            tsurf(ig) = Tiso
+          end do
+          do l=2,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = Tiso
+            end do
+          end do
+          flagiso=.true.
+          call initial0(llm*ip1jmp1,ucov)
+          call initial0(llm*ip1jm,vcov)
+          call initial0(ngridmx*(llm+1),q2)
+
+c       co2ice=0 : remove CO2 polar ice caps'
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'co2ice=0') then
+           do ig=1,ngridmx
+              co2ice(ig)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+        
+!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
+!       ----------------------------------------------------------------------
+
+	else if (trim(modif).eq.'therm_ini_s') then
+!          write(*,*)"surfithfi(1):",surfithfi(1)
+	  do isoil=1,nsoilmx
+	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+	  enddo
+          write(*,*)'OK: Soil thermal inertia has been reset to referenc
+     &e surface values'
+!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
+	  ithfi(:,:)=inertiedat(:,:)
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+!       subsoilice_n: Put deep ice layer in northern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (trim(modif).eq.'subsoilice_n') then
+
+         write(*,*)'From which latitude (in deg.), up to the north pole,
+     &should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.lt.0.).or.(val.gt.90)) then
+	      write(*,*)'Latitude should be between 0 and 90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+!	 if (val2.lt.layer(1)) then
+!	  iref=1
+!	 else
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+!	 endif
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+!	 write(*,*)'layer',layer
+!	 write(*,*)'mlayer',mlayer
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=1,jref
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=1,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+!         do i=1,nsoilmx
+!	  write(*,*)'i:',i,'ithfi(1,i):',ithfi(1,i)
+!	 enddo
+
+	
+!       subsoilice_s: Put deep ice layer in southern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (trim(modif).eq.'subsoilice_s') then
+
+         write(*,*)'From which latitude (in deg.), down to the south pol
+     &e, should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.gt.0.).or.(val.lt.-90)) then
+	      write(*,*)'Latitude should be between 0 and -90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=jref,jjp1
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=jref,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c       'mons_ice' : use MONS data to build subsurface ice table
+c       --------------------------------------------------------
+        else if (trim(modif).eq.'mons_ice') then
+        
+       ! 1. Load MONS data
+        call load_MONS_data(MONS_Hdn,MONS_d21)
+        
+        ! 2. Get parameters from user
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Northern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffN
+        enddo
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Southern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffS
+        enddo
+        ierr=1
+        do while (ierr.ne.0)
+          write(*,*) "Value of subterranean ice thermal inertia ",
+     &               " in Northern hemisphere?"
+          write(*,*) " (e.g.: 2000, or perhaps 2290)"
+!          read(*,*,iostat=ierr) iceith
+          read(*,*,iostat=ierr) iceithN
+        enddo
+        ierr=1
+        do while (ierr.ne.0)
+          write(*,*) "Value of subterranean ice thermal inertia ",
+     &               " in Southern hemisphere?"
+          write(*,*) " (e.g.: 2000, or perhaps 2290)"
+!          read(*,*,iostat=ierr) iceith
+          read(*,*,iostat=ierr) iceithS
+        enddo
+        
+        ! 3. Build subterranean thermal inertia
+        
+        ! initialise subsurface inertia with reference surface values
+        do isoil=1,nsoilmx
+          ithfi(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+        enddo
+        ! recast ithfi() onto ith()
+	call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+        
+        do i=1,iip1 ! loop on longitudes
+          do j=1,jjp1 ! loop on latitudes
+            ! set MONS_coeff
+            if (rlatu(j).ge.0) then ! northern hemisphere
+              ! N.B: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+              MONS_coeff=MONS_coeffN
+              iceith=iceithN
+            else ! southern hemisphere
+              MONS_coeff=MONS_coeffS
+              iceith=iceithS
+            endif
+            ! check if we should put subterranean ice
+            if (MONS_Hdn(i,j).ge.14.0) then ! no ice if Hdn<14%
+              ! compute depth at which ice lies:
+              val=MONS_d21(i,j)*MONS_coeff
+              ! compute val2= the diurnal skin depth of surface inertia
+              ! assuming a volumetric heat cap. of C=1.e6 J.m-3.K-1
+              val2=ith(i,j,1)*1.e-6*sqrt(88775./3.14159)
+              if (val.lt.val2) then
+                ! ice must be below the (surface inertia) diurnal skin depth
+                val=val2
+              endif
+              if (val.lt.layer(nsoilmx)) then ! subterranean ice
+                ! find the reference index iref that depth corresponds to
+                iref=0
+                do isoil=1,nsoilmx-1
+                 if ((val.ge.layer(isoil)).and.(val.lt.layer(isoil+1)))
+     &             then
+	           iref=isoil
+	           exit
+	         endif
+                enddo
+                ! Build "equivalent" thermal inertia for the mixed layer
+                ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val-layer(iref))/(ith(i,j,iref+1)**2))+
+     &                      ((layer(iref+1)-val)/(iceith)**2)))
+	        ! Set thermal inertia of lower layers
+                do isoil=iref+2,nsoilmx
+                  ith(i,j,isoil)=iceith 
+                enddo
+              endif ! of if (val.lt.layer(nsoilmx))
+            endif ! of if (MONS_Hdn(i,j).lt.14.0)
+          enddo ! do j=1,jjp1
+        enddo ! do i=1,iip1
+        
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+        ! recast ith() into ithfi()
+        CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+        
+	else
+          write(*,*) '       Unknown (misspelled?) option!!!'
+        end if ! of if (trim(modif) .eq. '...') elseif ...
+	
+       enddo ! of do ! infinite loop on liste of changes
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Correct pressure on the new grid (menu 0)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) * 
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+  
+c periodicity of surface ps in longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagiso) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
+     *                tetagdiv, tetagrot , tetatemp  )
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+         hour_ini=date-int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+c     CALL caldyn
+c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
+
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
+      CALL dynredem1("restart.nc",hour_ini,vcov,ucov,teta,q,
+     .               nqtot,masse,ps)
+C
+C Ecriture etat initial physique
+C
+
+      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
+     .              nqtot,dtphys,real(day_ini),0.0,
+     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nqtot,
+     .              dtphys,hour_ini,
+     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      write(*,*) "newstart: All is well that ends well."
+
+      end
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine load_MONS_data(MONS_Hdn,MONS_d21)
+      implicit none
+      ! routine to load Benedicte Diez MONS dataset, fill in date in southern
+      ! polar region, and interpolate the result onto the GCM grid
+#include"dimensions.h"
+#include"paramet.h"
+#include"datafile.h"
+#include"comgeom.h"
+      ! arguments:
+      real,intent(out) :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real,intent(out) :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! N.B MONS datasets should be of dimension (iip1,jjp1)
+      ! local variables:
+      character(len=88) :: filename="results_MONS_lat_lon_H_depth.txt"
+      character(len=88) :: txt ! to store some text
+      integer :: ierr,i,j
+      integer,parameter :: nblon=180 ! number of longitudes of MONS datasets
+      integer,parameter :: nblat=90 ! number of latitudes of MONS datasets
+      real :: pi
+      real :: longitudes(nblon) ! MONS dataset longitudes
+      real :: latitudes(nblat)  ! MONS dataset latitudes
+      ! MONS dataset: mass fraction of H2O where H is assumed to be in H2O
+      real :: Hdn(nblon,nblat)
+      real :: d21(nblon,nblat)! MONS dataset "depth" (g/cm2)
+
+      ! Extended MONS dataset (for interp_horiz)
+      real :: Hdnx(nblon+1,nblat)
+      real :: d21x(nblon+1,nblat)
+      real :: lon_bound(nblon+1) ! longitude boundaries
+      real :: lat_bound(nblat-1) ! latitude boundaries
+
+      ! 1. Initializations:
+
+      write(*,*) "Loading MONS data"
+
+      ! Open MONS datafile:
+      open(42,file=trim(datafile)//"/"//trim(filename),
+     &     status="old",iostat=ierr)
+      if (ierr/=0) then
+        write(*,*) "Error in load_MONS_data:"
+        write(*,*) "Failed opening file ",
+     &             trim(datafile)//"/"//trim(filename)
+        write(*,*)'1) You can change the path to the file in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary ',trim(filename),
+     &                 ' (and other datafiles)'
+        write(*,*)'   can be obtained online at:'
+        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
+        CALL ABORT
+      else ! skip first line of file (dummy read)
+         read(42,*) txt
+      endif
+
+      pi=2.*asin(1.)
+      
+      !2. Load MONS data (on MONS grid)
+      do j=1,nblat
+        do i=1,nblon
+        ! swap latitude index so latitudes go from north pole to south pole:
+          read(42,*) latitudes(nblat-j+1),longitudes(i),
+     &               Hdn(i,nblat-j+1),d21(i,nblat-j+1)
+        ! multiply d21 by 10 to convert from g/cm2 to kg/m2
+          d21(i,nblat-j+1)=d21(i,nblat-j+1)*10.0
+        enddo
+      enddo
+      close(42)
+      
+      ! there is unfortunately no d21 data for latitudes -77 to -90
+      ! so we build some by linear interpolation between values at -75
+      ! and assuming d21=0 at the pole
+      do j=84,90 ! latitudes(84)=-77 ; latitudes(83)=-75
+        do i=1,nblon
+          d21(i,j)=d21(i,83)*((latitudes(j)+90)/15.0)
+        enddo
+      enddo
+
+      ! 3. Build extended MONS dataset & boundaries (for interp_horiz)
+      ! longitude boundaries (in radians):
+      do i=1,nblon
+        ! NB: MONS data is every 2 degrees in longitude
+        lon_bound(i)=(longitudes(i)+1.0)*pi/180.0
+      enddo
+      ! extra 'modulo' value
+      lon_bound(nblon+1)=lon_bound(1)+2.0*pi
+      
+      ! latitude boundaries (in radians):
+      do j=1,nblat-1
+        ! NB: Mons data is every 2 degrees in latitude
+        lat_bound(j)=(latitudes(j)-1.0)*pi/180.0
+      enddo
+      
+      ! MONS datasets:
+      do j=1,nblat
+        Hdnx(1:nblon,j)=Hdn(1:nblon,j)
+        Hdnx(nblon+1,j)=Hdnx(1,j)
+        d21x(1:nblon,j)=d21(1:nblon,j)
+        d21x(nblon+1,j)=d21x(1,j)
+      enddo
+      
+      ! Interpolate onto GCM grid
+      call interp_horiz(Hdnx,MONS_Hdn,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      call interp_horiz(d21x,MONS_d21,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      
+      end subroutine
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F	(revision 1403)
@@ -0,0 +1,231 @@
+      SUBROUTINE readhead_NC (fichnom,
+     .           day0,
+     .           phis,constR)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+c====== includes de l ancien readhead ===
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "description.h"
+
+c======================================================================
+
+      CHARACTER*(*) fichnom
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+
+      INTEGER radpas
+
+      REAL xmin, xmax
+c
+      INTEGER  i
+
+c   Variables
+c
+      INTEGER length,iq
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid
+      CHARACTER  str3*3
+
+c
+      INTEGER day0
+      REAL phis(ip1jmp1),constR
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        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*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+
+
+c Info sur la Planete Mars pour la dynamique 
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+c      mugaz      = tab_cntrl(8)
+      cpp        =  744.499
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
+      preff=610.
+      WRITE (*,*) 'readhead -     preff ' , preff 
+c
+
+      day0=day_ini
+
+      constR=kappa*cpp
+      WRITE (*,*) 'constR = ' , constR
+      r=constR
+      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*, "readhead_NC: 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*, "readhead_NC: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: 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*, "readhead_NC: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <aire>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(aire)
+      xmax = MAXVAL(aire)
+      PRINT*,'Aires des mailles <aire>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: 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*, 'readhead_NC: Lecture echouee pour <phis>'
+         CALL abort
+      ENDIF
+c      PRINT*,'READHEAD_NC  Phis:',phis
+
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <aps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <bps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
+         CALL abort
+      ENDIF
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur  dtinteg =',i4//)
+
+      
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F	(revision 1403)
@@ -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.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/sponge.h
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F	(revision 1403)
@@ -0,0 +1,413 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      use comsoil_h, only: nsoilmx, inertiedat
+      use surfdat_h, only: ini_surfdat_h, qsurf
+      use comsoil_h, only: ini_comsoil_h
+      use comgeomphy, only: initcomgeomphy
+      use filtreg_mod, only: inifilr
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "ener.h"
+#include "description.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 :: q(:,:,:)   ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL 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 ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL tauscaling(ngridmx) ! dust conversion factor
+      REAL q2(ngridmx,llm+1)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      INTEGER*4 day_ini_fi
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1)
+      REAL tsoilS(ip1jmp1,nsoilmx)
+      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
+      REAL co2iceS(ip1jmp1)
+      REAL tauscalingS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1)
+      REAL,ALLOCATABLE :: qsurfS(:,:)
+      REAL emisS(ip1jmp1)
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+      integer :: nq,numvanle
+      character(len=30) :: txt ! to store some text
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .TRUE. )
+      grireg   = .TRUE.
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+
+! allocate arrays:
+      allocate(q(ip1jmp1,llm,nqtot))
+      allocate(qsurfS(ip1jmp1,nqtot))
+      call ini_surfdat_h(ngridmx,nqtot)
+      call ini_comsoil_h(ngridmx)
+      
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
+     &      day_ini_fi,timefi,tsurf,tsoil,emis,q2,qsurf,co2ice,
+     &      tauscaling)
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//fichnom
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.669)
+          day_ini=day_ini-669
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+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-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c tauscaling --> tauscalingS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      ! Note: thermal inertia "inertiedat" is in comsoil.h
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+           co2icetotal = co2icetotal + 
+     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+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 dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+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', 
+     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
+         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini + hour_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'tauscaling',
+     &  'dust conversion factor',' ',2,tauscalingS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+c       write(str2,'(i2.2)') iq
+c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
+c     .         3,q(1,1,iq))
+        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
+     &         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+c       write(str2,'(i2.2)') iq
+c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
+c     $  'kg.m-2',2,qsurfS(1,iq))
+        txt=trim(tname(iq))//"_surf"
+        call write_archive(nid,ntime,txt,'Tracer on surface',
+     &  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+c      do isoil=1,nsoilmx
+c       write(str2,'(i2.2)') isoil
+c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+c     .   'K',2,tsoilS(1,isoil))
+c      enddo
+
+! Write soil temperatures tsoil
+      call write_archive(nid,ntime,'tsoil','Soil temperature',
+     &     'K',-3,tsoilS)
+
+! Write soil thermal inertia
+      call write_archive(nid,ntime,'inertiedat',
+     &     'Soil thermal inertia',
+     &     'J.s-1/2.m-2.K-1',-3,ithS)
+
+! Write (0D) volumetric heat capacity (stored in comsoil.h)
+!      call write_archive(nid,ntime,'volcapa',
+!     &     'Soil volumetric heat capacity',
+!     &     'J.m-3.K-1',0,volcapa)
+! Note: no need to write volcapa, it is stored in "controle" table
+
+      ierr=NF_CLOSE(nid)
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+
+      write(*,*) "startarchive: all is well that ends well"
+      
+      end 
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F	(revision 1403)
@@ -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.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F	(revision 1403)
@@ -0,0 +1,252 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,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 comsoil_h, only: nsoilmx
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+!#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid
+      integer ntime ! time index
+      integer 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
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+! For an atmospheric 3D Variable
+!--------------------------------
+        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,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",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
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           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
+
+
+! For a subterranean 3D Variable
+!-------------------------------
+
+        else if (dim.eq.-3) then
+	! get variables' ID, if it exists
+	ierr=NF_INQ_VARID(nid,nom,varid)
+	
+	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
+	  ! build related coordinates
+	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
+	  if (ierr.ne.NF_NOERR) then
+	   write(*,*)"write_archive: dimension <subsurface_layers>",
+     &               " is missing !!!"
+	   call abort
+	  endif
+          ierr=NF_INQ_DIMID(nid,"Time",id(4))
+	  
+	  ! define the variable
+	  write(*,*)"====================="
+	  write(*,*)"defining ",nom
+	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+	  
+	 endif
+
+        ! build cedges and corners
+        corner(1)=1
+        corner(2)=1
+        corner(3)=1
+        corner(4)=ntime
+
+        edges(1)=iip1
+        edges(2)=jjp1
+        edges(3)=nsoilmx
+        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
+
+
+! For a surface 2D Variable
+!--------------------------
+
+        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,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",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,"Time",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
+
+        else
+	  write(*,*) "write_archive: dim=",dim," ?!?"
+	  call abort
+        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
+
+      return
+      end
+
Index: /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F
===================================================================
--- /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F	(revision 1403)
@@ -0,0 +1,547 @@
+      PROGRAM xvik
+
+      USE filtreg_mod, ONLY: inifilr
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c  Pression au site Viking
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+!#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"      
+
+
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,jj
+      REAL constR
+
+c   Declarations NCDF:
+c   -----------------
+      CHARACTER*100  varname
+      INTEGER ierr,nid,nvarid,dimid
+      LOGICAL nc
+      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
+      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
+
+c   declarations pour les points viking:
+c   ------------------------------------
+      INTEGER ivik(2),jvik(2),ifile(2),iv
+      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
+      REAL unanj
+
+c   variables meteo:
+c   ----------------
+      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
+      REAL co2ice(iip1,jjp1), captotN,captotS
+      real t7(iip1,jjp1) ! temperature in 7th atmospheric layer
+
+      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
+
+      LOGICAL firstcal,lcal,latcal,lvent,day_ls
+      INTEGER*4 day0
+
+      REAL ziceco2(iip1,jjp1)
+      REAL day,zt,sollong,sol,dayw
+      REAL airtot1,gh
+
+      INTEGER ii,iyear,kyear
+
+      CHARACTER*2 chr2
+
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER pathchmp*80,pathsor*80,nomfich*80
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL exner,pbar
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unanj=667.9
+      print*,'WARNING!!!',unanj,'Jours/an'
+      nc=.true.
+      lcal=.true.
+      latcal=.true.
+      lvent=.false.
+      day_ls=.true.
+
+c lecture du fichier xvik.def
+
+      phivik(1)=-3627
+      phivik(2)=-4505
+
+
+
+      OPEN(99,file='xvik.def',form='formatted')
+
+      READ(99,*) 
+      READ(99,*,iostat=ierr) phivik
+      IF(ierr.NE.0) GOTO 105
+
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathchmp
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathsor
+      READ(99,*,END=105)
+c     READ(99,'(l1)',END=105) day_ls
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lcal
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lvent
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) latcal
+ 
+ 105  CONTINUE
+      CLOSE(99)
+      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
+      DO iv=1,2
+         phivik(iv)=phivik(iv)*3.73
+      END DO
+
+      write(*,*) ' pathchmp:',trim(pathchmp)
+      write(*,*) ' pathsor:',trim(pathsor)
+      
+c-----------------------------------------------------------------------
+c-----------------------------------------------------------------------
+c   ouverture des fichiers xgraph:
+c   ------------------------------
+
+      ifile(1)=12
+      ifile(2)=13
+      kyear=-1
+c      OPEN(77,file='xlongday',form='formatted')
+
+      unitlec=11
+c
+      PRINT*,'entrer le nom du fichier NC'
+      READ(5,'(a)') nomfich
+
+      PRINT *,'nomfich : ',nomfich
+
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   grande boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      firstcal=.true.
+      DO WHILE(len_trim(nomfich).GT.0.AND.len_trim(nomfich).LT.50)
+      PRINT *,'>>>  nomfich : ',trim(nomfich)
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      file=pathchmp(1:len_trim(pathchmp))//'/'//
+     s     nomfich(1:len_trim(nomfich))
+      PRINT*,'file.nc: ', file(1:len_trim(file))//'.nc'
+      PRINT*,'timestep ',dtvr
+
+      IF(nc) THEN
+      ierr= NF_OPEN(file(1:len_trim(file))//'.nc',NF_NOWRITE,nid)        
+      ELSE
+         PRINT*,'Ouverture binaire ',file
+         OPEN(unitlec,file=file,status='old',form='unformatted',
+     .   iostat=ierr)
+      ENDIF
+
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+      CALL readhead_NC(file(1:len_trim(file))//'.nc',day0,phis,constR)
+
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+
+c   Lecture temps :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+
+        PRINT*,'temps',(temps(itau),itau=1,10)
+              
+c-----------------------------------------------------------------------
+c   coordonnees des point Viking:
+c   -----------------------------
+
+      latvik(1)=22.27*pi/180.
+      lonvik(1)=-47.9*pi/180.
+      latvik(2)=47.67*pi/180.
+      lonvik(2)=(360.-225.71)*pi/180.
+
+c   ponderations pour les 4 points autour de Viking
+      DO iv=1,2
+         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
+         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
+            ivik(iv)=ivik(iv)-1
+         ENDIF
+         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
+            jvik(iv)=jvik(iv)-1
+         ENDIF
+         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
+     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
+         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
+     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
+         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
+         zw(1,0,iv)=zalpha*(1.-zbeta)
+         zw(0,1,iv)=(1.-zalpha)*zbeta
+         zw(1,1,iv)=zalpha*zbeta
+      ENDDO
+
+c   altitude reelle et modele aux points Viking
+      DO iv=1,2
+         phisim(iv)=0.
+         DO jj=0,1
+            j=jvik(iv)+jj
+            DO ii=0,1
+               i=ivik(iv)+ii
+               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
+            ENDDO
+         ENDDO
+      ENDDO
+      PRINT*,'relief aux points Viking pour les sorties:',phivik
+
+c----------------------------------------------------------------------
+c   lectures des etats:
+c   -------------------
+
+       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+       count_ps=(/iip1,jjp1,1/)
+       count_co2ice=(/iip1,jjp1,1/)
+       count_temp=(/iip1,jjp1,llm,1/)
+       
+       DO itau=1,nbpas
+
+       start_ps=(/1,1,itau/)
+       start_co2ice=(/1,1,itau/)
+       start_temp=(/1,1,1,itau/)
+c   lecture drs des champs:
+c   -----------------------
+c         varname='u'
+c         ierr=drsread (unitlec,varname,unat,itau)
+c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
+c         varname='v'
+c         ierr=drsread (unitlec,varname,vnat,itau)
+c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "ps", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <ps>'
+            CALL abort
+          ENDIF
+          
+          PRINT*,'ps',ps(iip1/2,jjp1/2)
+
+ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "temp", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
+#else
+          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <temp>'
+            ! Ehouarn: proceed anyways
+            ! CALL abort
+            write(*,*)'--> Setting temperature to zero !!!'
+            t(1:iip1,1:jjp1,1:llm)=0.0
+            write(*,*)'--> looking for temp7 (temp in 7th layer)'
+            ierr=NF_INQ_VARID(nid,"temp7", nvarid)
+            if (ierr.eq.NF_NOERR) then
+            write(*,*) "    OK, found temp7 variable"
+#ifdef NC_DOUBLE
+            ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start_ps,count_ps,t7)
+#else
+            ierr=NF_GET_VARA_REAL(nid,nvarid,start_ps,count_ps,t7)
+#endif
+              if (ierr.ne.NF_NOERR) then
+                write(*,*)'xvik: failed loading temp7 !'
+                stop
+              endif
+            else ! no 'temp7' variable
+              write(*,*)'  No temp7 variable either !'
+              write(*,*)'  Will have to to without ...'
+              t7(1:iip1,1:jjp1)=0.0
+            endif
+          ELSE ! t() was successfully loaded, copy 7th layer to t7()
+            t7(1:iip1,1:jjp1)=t(1:iip1,1:jjp1,7)
+          ENDIF
+
+c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
+     &    count_co2ice,  co2ice)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
+     &    count_co2ice, co2ice)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
+            CALL abort
+          ENDIF
+
+
+c Gestion du temps
+c ----------------
+          day=temps(itau)
+          PRINT*,'day ',day
+          CALL solarlong(day+day0,sollong)
+          sol=day+day0+461.
+          iyear=sol/unanj
+          WRITE (*,*) 'iyear',iyear
+          sol=sol-iyear*unanj
+c
+c Ouverture / fermeture des fichiers
+c ----------------------------------
+          IF (iyear.NE.kyear) THEN
+             WRITE(chr2(1:1),'(i1)') iyear+1
+             WRITE (*,*) 'iyear bis',iyear
+             WRITE (*,*) 'chr2'
+             WRITE (*,*)  chr2
+             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
+             kyear=iyear
+             DO ii=1,2
+                CLOSE(10+ifile(ii))
+                CLOSE(2+ifile(ii))
+                CLOSE(4+ifile(ii))
+                CLOSE(6+ifile(ii))
+                CLOSE(8+ifile(ii))
+                CLOSE(16+ifile(ii))
+                CLOSE(12+ifile(ii))
+                CLOSE(14+ifile(ii))
+                CLOSE(97)
+                CLOSE(98)
+             ENDDO
+             CLOSE(5+ifile(1))
+             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
+             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
+c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
+c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
+             IF(lcal) THEN
+c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
+c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
+c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
+             ENDIF
+                         IF(latcal) THEN
+c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
+c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
+                         ENDIF
+             IF(lvent) THEN
+c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
+c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
+c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
+c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
+             ENDIF
+             OPEN(97,file='xprestot'//chr2,form='formatted')
+c            OPEN(98,file='xlat37_'//chr2,form='formatted')
+           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
+          ENDIF
+ 
+
+          sollong=sollong*180./pi
+          IF(day_ls) THEN
+             dayw=sol
+             write(*,*) 'dayw', dayw
+          ELSE
+             dayw=sollong
+          ENDIF
+
+c Calcul de la moyenne planetaire
+c -------------------------------
+          pstot=0.
+          captotS=0.
+          captotN=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                pstot=pstot+aire(i,j)*ps(i,j)
+             ENDDO
+          ENDDO
+ 
+              DO j=1,jjp1/2
+                 DO i=1,iim
+                    captotN = captotN  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              DO j=jjp1/2+1, jjp1
+                 DO i=1,iim
+                    captotS = captotS  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
+     &       , captotN*g*airtot1, captotS*g*airtot1          
+
+          IF(.NOT.firstcal) THEN
+         WRITE(98,'(f5.1,16f7.3)')
+     s    dayw,(ps(i,37),i=1,iim,4)
+
+c boucle sur les sites vikings:
+c ----------------------------
+
+          DO iv=1,2
+
+c interpolation de la temperature dans la 7eme couche, de la pression
+c de surface et des vents aux points viking.
+
+             zp1=0.
+             zp2=0.
+             zp2_sm=0.
+             zt=0.
+             zu=0.
+             zv=0.
+             DO jj=0,1
+                j=jvik(iv)+jj
+                DO ii=0,1
+                   i=ivik(iv)+ii
+!                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
+                   zt=zt+zw(ii,jj,iv)*t7(i,j)
+!                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
+                   zp1=zp1+zw(ii,jj,iv)*log(ps(i,j)) ! interpolate in log(P)
+                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
+                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
+                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
+                ENDDO
+             ENDDO
+             zp1=exp(zp1) ! because of the bilinear interpolation in log(P)
+ 
+c               pression au sol extrapolee a partir de la temp. 7eme couche
+           WRITE (*,*) 'constR ',constR 
+           WRITE (*,*) 'zt ',zt
+             gh=constR*zt
+             if (gh.eq.0) then ! if we don't have temperature values
+               ! assume a scale height of 10km
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/(3.73*1.e4))
+             else
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
+             endif
+           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
+           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
+!           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
+           WRITE(ifile(iv)+10,'(3e15.5)') dayw,zp2,zp1
+           
+c   sorties eventuelles de vent
+             IF(lvent) THEN
+                WRITE(ifile(iv)+16,'(2e15.5)')
+     s          dayw,zu
+                WRITE(ifile(iv)+12,'(2e15.5)')
+     s          dayw,zv
+             ENDIF
+          ENDDO
+c         IF (lcal) THEN
+c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
+c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
+c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
+c         ENDIF
+c            IF(latcal) THEN
+c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
+c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
+c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
+c            ENDIF
+         ENDIF
+         firstcal=.false.
+
+c======================================================================
+c   Fin de la boucle sur les etats du fichier histoire:
+c======================================================================
+      ENDDO
+
+      ierr= NF_CLOSE(nid)
+
+      PRINT*,'Fin du fichier',nomfich
+      print*,'Entrer un nouveau fichier ou return pour finir'
+      READ(5,'(a)',err=9999) nomfich
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   Fin de la boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      ENDDO
+
+      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
+      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
+      DO iv=1,2
+         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
+         WRITE(6,7777)
+     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
+         print*
+         DO j=jvik(iv)-1,jvik(iv)+2
+            WRITE(6,'(f8.1,10x,5f7.1)')
+     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
+         ENDDO
+         print*
+         print*,'zw'
+         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
+         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
+      ENDDO
+      PRINT*,'R=',r
+ 9999  PRINT*,'Fin '
+
+7777  FORMAT ('latitude/longitude',4f7.1)
+      END
Index: /trunk/LMDZ.MARS/libf/filtrez/coefils.h
===================================================================
--- /trunk/LMDZ.MARS/libf/filtrez/coefils.h	(revision 1402)
+++ /trunk/LMDZ.MARS/libf/filtrez/coefils.h	(revision 1403)
@@ -1,7 +1,7 @@
-      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
-     * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
-     * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
-     * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
-c
+      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
+     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
+     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
+     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
+!c
       INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
       REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
Index: /trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90	(revision 1403)
@@ -0,0 +1,590 @@
+MODULE filtreg_mod
+
+CONTAINS
+
+      SUBROUTINE inifilr
+!
+!    ... H. Upadhyaya, O.Sharma   ...
+!
+      IMPLICIT NONE
+!
+!     version 3 .....
+
+!     Correction  le 28/10/97    P. Le Van .
+!  -------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+!  -------------------------------------------------------------------
+#include "comgeom.h"
+#include "coefils.h"
+#include "logic.h"
+#include "serre.h"
+
+      REAL  dlonu(iim),dlatu(jjm)
+      REAL  rlamda( iim ),  eignvl( iim )
+!
+
+      REAL    lamdamax,pi,cof
+      INTEGER i,j,modemax,imx,k,kf,ii
+      REAL dymin,dxmin,colat0
+      REAL eignft(iim,iim), coff
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs 
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus) &
+                   , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs) &
+                   ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+#ifdef CRAY
+      INTEGER   ISMIN
+      EXTERNAL  ISMIN
+      INTEGER iymin 
+      INTEGER ixmineq
+#endif
+      EXTERNAL  inifgn
+!
+! ------------------------------------------------------------
+!   This routine computes the eigenfunctions of the laplacien
+!   on the stretched grid, and the filtering coefficients
+!      
+!  We designate:
+!   eignfn   eigenfunctions of the discrete laplacien
+!   eigenvl  eigenvalues
+!   jfiltn   indexof the last scalar line filtered in NH
+!   jfilts   index of the first line filtered in SH
+!   modfrst  index of the mode from where modes are filtered
+!   modemax  maximum number of modes ( im )
+!   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
+!   sdd      SQRT( dx )
+!      
+!     the modes are filtered from modfrst to modemax
+      
+!-----------------------------------------------------------
+!
+
+       pi       = 2. * ASIN( 1. )
+
+       DO i = 1,iim
+        dlonu(i) = xprimu( i )
+       ENDDO
+!
+       CALL inifgn(eignvl)
+!
+        print *,' EIGNVL '
+        PRINT 250,eignvl
+250     FORMAT( 1x,5e13.6)
+!
+! compute eigenvalues and eigenfunctions
+!
+!
+!.................................................................
+!
+!  compute the filtering coefficients for scalar lines and 
+!  meridional wind v-lines
+!
+!  we filter all those latitude lines where coefil < 1
+!  NO FILTERING AT POLES
+!
+!  colat0 is to be used  when alpha (stretching coefficient)
+!  is set equal to zero for the regular grid case 
+!
+!    .......   Calcul  de  colat0   .........
+!     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
+!
+!
+      DO 45 j = 1,jjm
+         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
+ 45   CONTINUE
+!
+#ifdef CRAY
+      iymin   = ISMIN( jjm, dlatu, 1 )
+      ixmineq = ISMIN( iim, dlonu, 1 )
+      dymin   = dlatu( iymin )
+      dxmin   = dlonu( ixmineq )
+#else
+      dxmin   =  dlonu(1)
+       DO  i  = 2, iim
+        dxmin = MIN( dxmin,dlonu(i) )
+       ENDDO
+      dymin  = dlatu(1)
+       DO j  = 2, jjm
+        dymin = MIN( dymin,dlatu(j) )
+       ENDDO
+#endif
+!
+!
+      colat0  =  MIN( 0.5, dymin/dxmin )
+!
+      IF( .NOT.fxyhypb.AND.ysinus )  THEN
+           colat0 = 0.6
+!         ...... a revoir  pour  ysinus !   .......
+           alphax = 0.
+      ENDIF
+!
+      PRINT 50, colat0,alphax
+  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
+!
+      IF(alphax.EQ.1. )  THEN
+        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
+         STOP
+      ENDIF
+!
+      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
+
+!c                        ... Correction  le 28/10/97  ( P.Le Van ) ..
+!
+      DO 71 i = 2,iim
+       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
+ 71   CONTINUE
+!
+
+      DO 72 j = 1,jjm
+	    DO 73 i = 1,iim
+	    coefilu( i,j )  = 0.0
+	    coefilv( i,j )  = 0.0
+	    coefilu2( i,j ) = 0.0
+	    coefilv2( i,j ) = 0.0
+ 73     CONTINUE
+ 72   CONTINUE
+
+!
+!    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
+!    .........................................................
+!
+       modemax = iim
+
+!ccc    imx = modemax - 4 * (modemax/iim)
+
+       imx  = iim
+!
+       PRINT *,' TRUNCATION AT ',imx
+!
+      DO 75 j = 2, jjm/2+1
+       cof = COS( rlatu(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+        ENDIF
+
+       cof = COS( rlatu(jjp1-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) &
+            jfiltsu= jjp1-j+1
+        ENDIF
+ 75   CONTINUE
+!
+      DO 76 j = 1, jjm/2
+       cof = COS( rlatv(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+        ENDIF
+
+       cof = COS( rlatv(jjm-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) &
+             jfiltsv= jjm-j+1
+        ENDIF
+ 76   CONTINUE
+!                                 
+
+      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
+        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
+        STOP
+      ENDIF
+
+      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
+        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
+        STOP
+      ENDIF
+
+      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
+        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
+        STOP
+      ENDIF
+
+      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
+        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
+        STOP
+      ENDIF
+
+       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' , &
+                 jfiltnv,jfiltsv,jfiltnu,jfiltsu
+
+!                                 
+!   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
+!................................................................
+!
+!
+      DO 77 j = 1,jjm
+	  modfrstu( j ) = iim
+	  modfrstv( j ) = iim
+ 77   CONTINUE
+!
+      DO 84 j = 2,jfiltnu
+       DO 81 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 82
+ 81    CONTINUE
+      GOTO 84
+ 82   modfrstu( j ) = k
+!
+	  kf = modfrstu( j )
+	   DO 83 k = kf , modemax
+        cof = rlamda(k) * COS( rlatu(j) )
+	    coefilu(k,j) = cof - 1.
+	    coefilu2(k,j) = cof*cof - 1.
+ 83    CONTINUE
+ 84   CONTINUE
+!                                 
+!
+      DO 89 j = 1,jfiltnv
+!
+       DO 86 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 87
+ 86    CONTINUE
+      GOTO 89
+ 87   modfrstv( j ) = k
+!
+	   kf = modfrstv( j )
+	   DO 88 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 88    CONTINUE
+!
+ 89    CONTINUE
+!
+      DO 94 j = jfiltsu,jjm
+       DO 91 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 92
+ 91    CONTINUE
+      GOTO 94
+ 92   modfrstu( j ) = k
+!
+        kf = modfrstu( j )
+	 DO 93 k = kf , modemax
+          cof = rlamda(k) * COS( rlatu(j) )
+	  coefilu(k,j) = cof - 1.
+	  coefilu2(k,j) = cof*cof - 1.
+ 93      CONTINUE
+ 94    CONTINUE
+!                                 
+      DO 99 j = jfiltsv,jjm
+       DO 96 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 97
+ 96    CONTINUE
+      GOTO 99
+ 97   modfrstv( j ) = k
+!
+       kf = modfrstv( j )
+	   DO 98 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 98    CONTINUE
+ 99   CONTINUE
+!
+
+       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
+
+         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
+         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
+
+          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , &
+              jfiltnv,jfiltsv,jfiltnu,jfiltsu
+       ENDIF
+
+       PRINT *,'   Modes premiers  v  '
+       PRINT 334,modfrstv
+       PRINT *,'   Modes premiers  u  '
+       PRINT 334,modfrstu
+
+     
+      IF( nfilun.LT. jfiltnu )  THEN
+       PRINT *,' le parametre nfilun utilise pour la matrice ', &
+         ' matriceun  est trop petit ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilun.GT. jfiltnu+ 2 )  THEN
+           PRINT *,' le parametre nfilun utilise pour la matrice ', &
+      ' matriceun est trop grand ! Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
+            PRINT *,' le parametre nfilus utilise pour la matrice ', &
+         ' matriceus  est trop petit !  '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ', &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
+           PRINT *,' le parametre nfilus utilise pour la matrice ', &
+       ' matriceus  est trop grand ! ' 
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' , &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvn.LT. jfiltnv )  THEN
+            PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+         ' matricevn  est trop petit ! '  
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
+           PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+      ' matricevn est trop grand !  Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
+            PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+         ' matricevs  est trop petit !  Le changer dans parafilt.h '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+       , jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
+           PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+       ' matricevs  est trop grand ! Gachis de memoire ! '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+         ,  jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+
+!  
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
+!                       sur la grille scalaire                 ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
+#else
+#ifdef BLAS
+         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+         eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceun(i,k,j) = 0.0
+            DO ii = 1, iim
+               matriceun(i,k,j) = matriceun(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnv, iim, eignft, iim, 0.0, &
+                 matriceus(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceus(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1) &
+                                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
+!                       sur la grille   de V ou de Z           ........
+!   ...................................................................
+!
+        DO j = 1, jfiltnv
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+           DO k = 1, iim
+            eignft(i,k) = eignfnu(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matricevn(i,k,j) = matricevn(i,k,j) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsv, jjm
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+            DO k = 1, iim
+             eignft(i,k) = eignfnu(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnu, iim, eignft, iim, 0.0, &
+                 matricevs(1,1,j-jfiltsv+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevs(i,k,j-jfiltsv+1) = 0.0
+            DO ii = 1, iim
+               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
+!              sur la grille scalaire , pour le filtre inverse ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i = 1,iim
+          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matrinvn(i,k,j) = matrinvn(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i = 1,iim
+          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+       eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvs(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+
+!
+334    FORMAT(1x,24i3)
+755    FORMAT(1x,6f10.3,i3)
+
+       RETURN
+       END SUBROUTINE inifilr
+
+END MODULE  filtreg_mod
Index: unk/LMDZ.MARS/libf/filtrez/inifilr.F
===================================================================
--- /trunk/LMDZ.MARS/libf/filtrez/inifilr.F	(revision 1402)
+++ 	(revision )
@@ -1,584 +1,0 @@
-      SUBROUTINE inifilr
-c
-c    ... H. Upadhyaya, O.Sharma   ...
-c
-      IMPLICIT NONE
-c
-c     version 3 .....
-
-c     Correction  le 28/10/97    P. Le Van .
-c  -------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "parafilt.h"
-c  -------------------------------------------------------------------
-#include "comgeom.h"
-#include "coefils.h"
-#include "logic.h"
-#include "serre.h"
-
-      REAL  dlonu(iim),dlatu(jjm)
-      REAL  rlamda( iim ),  eignvl( iim )
-c
-
-      REAL    lamdamax,pi,cof
-      INTEGER i,j,modemax,imx,k,kf,ii
-      REAL dymin,dxmin,colat0
-      REAL eignft(iim,iim), coff
-      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
-      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
-     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
-     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
-#ifdef CRAY
-      INTEGER   ISMIN
-      EXTERNAL  ISMIN
-      INTEGER iymin 
-      INTEGER ixmineq
-#endif
-      EXTERNAL  inifgn
-c
-c ------------------------------------------------------------
-c   This routine computes the eigenfunctions of the laplacien
-c   on the stretched grid, and the filtering coefficients
-c      
-c  We designate:
-c   eignfn   eigenfunctions of the discrete laplacien
-c   eigenvl  eigenvalues
-c   jfiltn   indexof the last scalar line filtered in NH
-c   jfilts   index of the first line filtered in SH
-c   modfrst  index of the mode from where modes are filtered
-c   modemax  maximum number of modes ( im )
-c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
-c   sdd      SQRT( dx )
-c      
-c     the modes are filtered from modfrst to modemax
-c      
-c-----------------------------------------------------------
-c
-
-       pi       = 2. * ASIN( 1. )
-
-       DO i = 1,iim
-        dlonu(i) = xprimu( i )
-       ENDDO
-c
-       CALL inifgn(eignvl)
-c
-        print *,' EIGNVL '
-        PRINT 250,eignvl
-250     FORMAT( 1x,5e13.6)
-c
-c compute eigenvalues and eigenfunctions
-c
-c
-c.................................................................
-c
-c  compute the filtering coefficients for scalar lines and 
-c  meridional wind v-lines
-c
-c  we filter all those latitude lines where coefil < 1
-c  NO FILTERING AT POLES
-c
-c  colat0 is to be used  when alpha (stretching coefficient)
-c  is set equal to zero for the regular grid case 
-c
-c    .......   Calcul  de  colat0   .........
-c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
-c
-c
-      DO 45 j = 1,jjm
-         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
- 45   CONTINUE
-c
-#ifdef CRAY
-      iymin   = ISMIN( jjm, dlatu, 1 )
-      ixmineq = ISMIN( iim, dlonu, 1 )
-      dymin   = dlatu( iymin )
-      dxmin   = dlonu( ixmineq )
-#else
-      dxmin   =  dlonu(1)
-       DO  i  = 2, iim
-        dxmin = MIN( dxmin,dlonu(i) )
-       ENDDO
-      dymin  = dlatu(1)
-       DO j  = 2, jjm
-        dymin = MIN( dymin,dlatu(j) )
-       ENDDO
-#endif
-c
-c
-      colat0  =  MIN( 0.5, dymin/dxmin )
-c
-      IF( .NOT.fxyhypb.AND.ysinus )  THEN
-           colat0 = 0.6
-c         ...... a revoir  pour  ysinus !   .......
-           alphax = 0.
-      ENDIF
-c
-      PRINT 50, colat0,alphax
-  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
-c
-      IF(alphax.EQ.1. )  THEN
-        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
-         STOP
-      ENDIF
-c
-      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
-
-cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
-c
-      DO 71 i = 2,iim
-       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
- 71   CONTINUE
-c
-
-      DO 72 j = 1,jjm
-	    DO 73 i = 1,iim
-	    coefilu( i,j )  = 0.0
-	    coefilv( i,j )  = 0.0
-	    coefilu2( i,j ) = 0.0
-	    coefilv2( i,j ) = 0.0
- 73     CONTINUE
- 72   CONTINUE
-
-c
-c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
-c    .........................................................
-c
-       modemax = iim
-
-cccc    imx = modemax - 4 * (modemax/iim)
-
-       imx  = iim
-c
-       PRINT *,' TRUNCATION AT ',imx
-c
-      DO 75 j = 2, jjm/2+1
-       cof = COS( rlatu(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
-        ENDIF
-
-       cof = COS( rlatu(jjp1-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
-     $      jfiltsu= jjp1-j+1
-        ENDIF
- 75   CONTINUE
-c
-      DO 76 j = 1, jjm/2
-       cof = COS( rlatv(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
-        ENDIF
-
-       cof = COS( rlatv(jjm-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
-     $       jfiltsv= jjm-j+1
-        ENDIF
- 76   CONTINUE
-c                                 
-
-      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
-        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
-        STOP
-      ENDIF
-
-      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
-        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
-        STOP
-      ENDIF
-
-      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
-        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
-        STOP
-      ENDIF
-
-      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
-        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
-        STOP
-      ENDIF
-
-       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
-     *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
-
-c                                 
-c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
-c................................................................
-c
-c
-      DO 77 j = 1,jjm
-	  modfrstu( j ) = iim
-	  modfrstv( j ) = iim
- 77   CONTINUE
-c
-      DO 84 j = 2,jfiltnu
-       DO 81 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 82
- 81    CONTINUE
-      GOTO 84
- 82   modfrstu( j ) = k
-c
-	  kf = modfrstu( j )
-	   DO 83 k = kf , modemax
-        cof = rlamda(k) * COS( rlatu(j) )
-	    coefilu(k,j) = cof - 1.
-	    coefilu2(k,j) = cof*cof - 1.
- 83    CONTINUE
- 84   CONTINUE
-c                                 
-c
-      DO 89 j = 1,jfiltnv
-c
-       DO 86 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 87
- 86    CONTINUE
-      GOTO 89
- 87   modfrstv( j ) = k
-c
-	   kf = modfrstv( j )
-	   DO 88 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 88    CONTINUE
-c
- 89    CONTINUE
-c
-      DO 94 j = jfiltsu,jjm
-       DO 91 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 92
- 91    CONTINUE
-      GOTO 94
- 92   modfrstu( j ) = k
-c
-        kf = modfrstu( j )
-	 DO 93 k = kf , modemax
-          cof = rlamda(k) * COS( rlatu(j) )
-	  coefilu(k,j) = cof - 1.
-	  coefilu2(k,j) = cof*cof - 1.
- 93      CONTINUE
- 94    CONTINUE
-c                                 
-      DO 99 j = jfiltsv,jjm
-       DO 96 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 97
- 96    CONTINUE
-      GOTO 99
- 97   modfrstv( j ) = k
-c
-       kf = modfrstv( j )
-	   DO 98 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 98    CONTINUE
- 99   CONTINUE
-c
-
-       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
-
-         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
-         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
-
-          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
-     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
-       ENDIF
-
-       PRINT *,'   Modes premiers  v  '
-       PRINT 334,modfrstv
-       PRINT *,'   Modes premiers  u  '
-       PRINT 334,modfrstu
-
-     
-      IF( nfilun.LT. jfiltnu )  THEN
-       PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *   ' matriceun  est trop petit ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilun.GT. jfiltnu+ 2 )  THEN
-           PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *' matriceun est trop grand ! Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
-            PRINT *,' le parametre nfilus utilise pour la matrice ',
-     *   ' matriceus  est trop petit !  '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ',
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
-           PRINT *,' le parametre nfilus utilise pour la matrice ',
-     * ' matriceus  est trop grand ! ' 
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvn.LT. jfiltnv )  THEN
-            PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *   ' matricevn  est trop petit ! '  
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
-           PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *' matricevn est trop grand !  Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
-            PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     * , jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
-           PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     * ' matricevs  est trop grand ! Gachis de memoire ! '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     *   ,  jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-
-c  
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
-c                       sur la grille scalaire                 ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
-#else
-#ifdef BLAS
-         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceun(i,k,j) = 0.0
-            DO ii = 1, iim
-               matriceun(i,k,j) = matriceun(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnv, iim, eignft, iim, 0.0, 
-     $           matriceus(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceus(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
-     .                                    + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
-c                       sur la grille   de V ou de Z           ........
-c   ...................................................................
-c
-        DO j = 1, jfiltnv
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-           DO k = 1, iim
-            eignft(i,k) = eignfnu(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matricevn(i,k,j) = matricevn(i,k,j)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsv, jjm
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-            DO k = 1, iim
-             eignft(i,k) = eignfnu(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnu, iim, eignft, iim, 0.0, 
-     $           matricevs(1,1,j-jfiltsv+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevs(i,k,j-jfiltsv+1) = 0.0
-            DO ii = 1, iim
-               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
-c              sur la grille scalaire , pour le filtre inverse ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i = 1,iim
-          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matrinvn(i,k,j) = matrinvn(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i = 1,iim
-          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvs(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-
-c
-334    FORMAT(1x,24i3)
-755    FORMAT(1x,6f10.3,i3)
-
-       RETURN
-       END
Index: /trunk/LMDZ.MARS/libf/filtrez/parafilt.h
===================================================================
--- /trunk/LMDZ.MARS/libf/filtrez/parafilt.h	(revision 1402)
+++ /trunk/LMDZ.MARS/libf/filtrez/parafilt.h	(revision 1403)
@@ -1,40 +1,40 @@
         INTEGER nfilun, nfilus, nfilvn, nfilvs
-c
-c 48 32 19 non-zoom:
-c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
-c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
-c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
-c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
-cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
-c
-c
-c 96 49 11 non-zoom:
-ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
-c
-c
-c 144 73 11 non-zoom:
-ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
-c
-c 192 143 19 non-zoom:
-c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
-c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
-c      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
+!
+! 48 32 19 non-zoom:
+!       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
+!        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
+!         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
+!        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
+!maf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
+!
+!
+! 96 49 11 non-zoom:
+!cc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
+!
+!
+! 144 73 11 non-zoom:
+!cc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
+!
+! 192 143 19 non-zoom:
+!             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
+!      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
+!      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
 !!        PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
         PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
-c 96 72 19 non-zoom:
-ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
-c
-c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
-c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
-c
-c
-c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
-c
-c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
-c
-c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
-c
-c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
-c
-c      Parameter  ci-dessus  et de relancer  le  run .  
+! 96 72 19 non-zoom:
+!cc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
+!
+!        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
+!       PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
+!
+!
+!      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
+!
+!      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
+!
+!      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
+!
+!      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
+!
+!      Parameter  ci-dessus  et de relancer  le  run .  
 
Index: /trunk/LMDZ.MARS/libf/misc/cbrt.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/cbrt.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/cbrt.F	(revision 1403)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/misc/cvmgp.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/cvmgp.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/cvmgp.F	(revision 1403)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: /trunk/LMDZ.MARS/libf/misc/cvmgt.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/cvmgt.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/cvmgt.F	(revision 1403)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: /trunk/LMDZ.MARS/libf/misc/from36.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/from36.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/from36.F	(revision 1403)
@@ -0,0 +1,111 @@
+      SUBROUTINE from36(x,nbre,iunit)
+      IMPLICIT NONE
+c====================================================================
+      INTEGER iunit, nbre
+      REAL x(nbre)
+c====================================================================
+      INTEGER i, l
+      INTEGER nbreok, ibaseok, icase
+      REAL xmax, xmin, errcod
+c====================================================================
+      INTEGER lbord
+      PARAMETER (lbord=255)
+      REAL conv(0:lbord)
+c====================================================================     
+      INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxcas=3, maxnbr=100000)
+      PARAMETER(ifact1=ibase**1-1)
+      PARAMETER(ifact2=ibase**2-1)
+      PARAMETER(ifact3=ibase**3-1)
+      CHARACTER*1 base(ibase), fac(maxcas,maxnbr)
+      INTEGER inte(maxcas)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c====================================================================
+      IF (nbre .GT. maxnbr) THEN
+      PRINT*, 'Verifier maxnbr dans from36 (trop petite)'
+      STOP
+      ENDIF
+      DO 10 i = 0, lbord
+   10 conv(i) = 1.0e+33
+c    34  c  10 conv(i) = 1.0e+49
+      DO 20 i = 1, ibase
+      l = ICHAR(base(i))
+   20 conv(l) = FLOAT(i-1)
+c====================================================================
+      READ (iunit,*) nbreok, ibaseok, icase
+        IF (nbre .NE. nbreok) THEN
+          PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre
+          STOP
+        ENDIF
+        IF (ibase .NE. ibaseok) THEN
+          PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase
+          STOP
+        ENDIF
+        IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN
+          PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire', 
+     .             icase
+          STOP
+        ENDIF
+c====================================================================
+      READ (iunit,*) xmin
+      READ (iunit,*) xmax
+        PRINT*,'Xmin et Xmax=', xmin, xmax
+c====================================================================
+      IF (xmin .EQ. xmax) THEN
+        READ(iunit,'(a)')
+        PRINT*, 'Ce champ est constant'
+        DO 30 i = 1, nbre
+   30   x(i) = xmin
+        GO TO 123
+      END IF
+c====================================================================
+      IF (icase .EQ. 1) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact1)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 190 i = 1, nbre
+        x(i) = 0.0
+        DO 191 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  191   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin)
+  190   CONTINUE
+      ELSE IF (icase .EQ. 2) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact2)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 290 i = 1, nbre
+        x(i) = 0.0
+        DO 291 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  291   CONTINUE
+        x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin)
+  290   CONTINUE
+      ELSE IF (icase .EQ. 3) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact3)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 390 i = 1, nbre
+        x(i) = 0.0
+        DO 391 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  391   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin)
+  390   CONTINUE
+      ELSE
+        PRINT*, 'Verfier icase (1, 2 ou 3)'
+        STOP
+      ENDIF
+   91 FORMAT(120a1)
+   92 FORMAT(64(2a1))
+   93 FORMAT(40(3a1))
+c====================================================================
+  123 RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/misc/gather.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/gather.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/gather.F	(revision 1403)
@@ -0,0 +1,16 @@
+      SUBROUTINE GATHER(n,a,b,index)
+c
+      IMPLICIT NONE
+C
+      INTEGER n,index(n),i
+      REAL a(n),b(n)
+c
+      DO 100 i=1,n
+        a(i)=b(index(i))
+100   CONTINUE
+c
+      RETURN
+      END
+c
+c     voir aussi vec_gather(v,vindices,count,r)...p.11-14
+c  
Index: /trunk/LMDZ.MARS/libf/misc/ilsum.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ilsum.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ilsum.F	(revision 1403)
@@ -0,0 +1,19 @@
+      FUNCTION ilsum(n, logic, inc)
+c
+      IMPLICIT NONE
+c
+      integer ilsum
+      integer n, inc
+      logical logic((n-1)*inc+1)
+c
+      integer i, in
+c
+      ilsum = 0.
+      in = 1
+      do 10 i = 1, n
+         if (logic(in)) ilsum = ilsum + 1
+         in=in+inc
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/ini36.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ini36.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ini36.F	(revision 1403)
@@ -0,0 +1,46 @@
+      SUBROUTINE ini36
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c====================================================================
+c-- cette routine fait l'initialisation pour le codage sur base 36
+c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases
+      INTEGER i,j,k,l, ijk, jk
+c====================================================================
+      INTEGER ibase, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36)
+      PARAMETER (ifact1 = ibase-1)
+      PARAMETER (ifact2 = ibase*ibase-1)
+      PARAMETER (ifact3 = ibase*ibase*ibase-1)
+c====================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+c====================================================================
+      CHARACTER*1 base(ibase)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c===================================================================
+      DO 30 i = 1, ibase
+      DO 30 j = 1, ibase
+      DO 30 k = 1, ibase
+      ijk = ( (i-1)*ibase + j-1 )*ibase + k-1
+      word3(ijk) = base(i)//base(j)//base(k)
+   30 CONTINUE
+      DO 20 j = 1, ibase
+      DO 20 k = 1, ibase
+      jk = (j-1)*ibase + k-1
+      word2(jk) = base(j)//base(k)
+   20 CONTINUE
+      DO 10 k = 1, ibase
+      word1(k-1) = base(k)
+   10 CONTINUE
+c===================================================================
+      RETURN
+      END
+
Index: /trunk/LMDZ.MARS/libf/misc/iniprint.h
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/iniprint.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/iniprint.h	(revision 1403)
@@ -0,0 +1,11 @@
+!
+! $Id: $
+!
+!
+! handle debug and output levels
+! lunout:    unit of file where outputs will be sent
+!                           (default is 6, standard output)
+! prt_level: level of informative output messages (0 = minimum)
+!
+      INTEGER lunout, prt_level
+      COMMON /comprint/ lunout, prt_level
Index: /trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
@@ -0,0 +1,219 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE ioipsl_errioipsl
Index: /trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90	(revision 1403)
@@ -0,0 +1,1980 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the run.def file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the run.def file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from run.def
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = 'run.def'
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file='run.def.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of run.def and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE ioipsl_getincom
Index: /trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90	(revision 1403)
@@ -0,0 +1,243 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE ioipsl_stringop
Index: /trunk/LMDZ.MARS/libf/misc/isamax.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/isamax.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/isamax.F	(revision 1403)
@@ -0,0 +1,21 @@
+      function isamax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,isamax,ix
+      real sx((n-1)*incx+1),sxmax,abssx
+c
+      ix=1
+      isamax=1
+      sxmax=ABS(sx(1))
+      do 10 i=1,n-1
+         ix=ix+incx
+         abssx=ABS(sx(ix))
+         if(abssx.gt.sxmax) then
+             sxmax=abssx
+             isamax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/isitor.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/isitor.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/isitor.F	(revision 1403)
@@ -0,0 +1,64 @@
+
+      SUBROUTINE isitor(filename,writeornot,filenum, files)
+
+C--------------------------------------------------------------------
+C Subroutine qui determine si un fichier doit etre ecrit ou non
+C--------------------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     filename: CHARACTER*20 
+C               nom du fichier dont on veut savoir si il doit etre ecrit
+C     writeornot: LOGICAL
+C                 Variable de sortie qui est vraie si le champ doit etre ecrit
+C     filenum: INTEGER
+C              nombre de fichier dans la list files
+C     files: CHARACTER*20 files(100)
+C            c'est la liste des fichier qui doivent etre ecrit et dans
+C            lequel on vas voir si filename y est.
+C
+
+
+      IMPLICIT NONE
+      CHARACTER*20 filename, checkname
+      CHARACTER*1 separator
+      LOGICAL writeornot, check
+      INTEGER iletter, ifile
+      INTEGER filenum
+      CHARACTER*20 files(100)
+
+      writeornot = .FALSE.
+      check = .FALSE.
+      separator = '/'
+
+      DO 6565 iletter = 20,1,-1
+
+        IF (filename(iletter:iletter) .EQ. separator) THEN
+
+          checkname = filename(iletter+1:20)
+    
+        ELSE
+        ENDIF
+ 6565 CONTINUE
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: filename=',filename,
+     &             'checkname=',checkname
+      ENDIF
+
+      DO 6767 ifile = 1,filenum
+
+      IF (files(ifile) .EQ. checkname ) THEN
+       
+      writeornot = .TRUE. 
+
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
+      ENDIF
+
+ 6767 CONTINUE
+
+      RETURN
+      END
+
Index: /trunk/LMDZ.MARS/libf/misc/ismax.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ismax.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ismax.F	(revision 1403)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/ismin.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ismin.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ismin.F	(revision 1403)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+	 ix=ix+incx
+	 if(sx(ix).lt.sxmin) then
+	     sxmin=sx(ix)
+	     ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/lmdstd.h
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/lmdstd.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/lmdstd.h	(revision 1403)
@@ -0,0 +1,31 @@
+c=======================================================================
+c   INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+
+      INTEGER bandmax
+      PARAMETER(bandmax=24)
+
+      COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+     $                gentete,gdatedep,gdatefin
+        
+      CHARACTER*100 gtitre    !du champ
+      CHARACTER*20  gunites   !unites du champ
+      CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+      CHARACTER*100 gfichier  !nom du fichier contenant le champ
+      CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+      CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+      CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+      CHARACTER*20  glistfich !liste de champs a sortir
+
+      COMMON/lmdstdnu/ gminimum,gmaximum,
+     $                 gdeltajour(bandmax),gdeltapas(bandmax),
+     $                 gnbetats(bandmax),gnbfich
+
+      REAL    gminimum        ! \    min et max
+      REAL    gmaximum        ! /    du champ
+      INTEGER gnbfich         ! nombre de fichier a sortir
+c  pour les evolutions temporelles:
+      INTEGER gnbetats        ! nombre d'etats par bande
+      INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+      REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+
+c=======================================================================
Index: /trunk/LMDZ.MARS/libf/misc/lnblnk.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/lnblnk.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/lnblnk.F	(revision 1403)
@@ -0,0 +1,36 @@
+      INTEGER FUNCTION lnblnk (letter)
+
+C--------------------------------------------------------
+C Fonction qui determine la longeur d'un string sans les
+C blancs qui suivent. Le critere pour determiner la fin du
+C string est, trois blancs de suite
+C---------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     letter: CHARACTER*xxx (xxx < imax)
+C             le string dont on determine la longuer
+C     lnblnk: INTEGER
+C             le nombre de characteres
+C
+C     PARAMETER
+C     +++++++++
+C     imax : INTEGER
+C            le nombre maximale de character que peut contenir le string
+C            a traiter
+
+      IMPLICIT NONE
+      INTEGER i,imax
+      PARAMETER (imax = 256)
+      CHARACTER*256 letter
+
+      i=0
+
+10    i=i+1
+      IF (letter(i:i+3) . EQ . '   ') GOTO 20
+      GOTO 10
+
+20    lnblnk=i-1
+
+      RETURN
+      END
+
Index: /trunk/LMDZ.MARS/libf/misc/mxm.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/mxm.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/mxm.F	(revision 1403)
@@ -0,0 +1,34 @@
+       SUBROUTINE MXM(A,NAR,B,NAC,C,NBC)
+c
+c
+c    Multiplication of matrix A by matrix B ,and result in matrix C
+c
+c
+c      NAR : number of   rows  for matrix  A and  matrix  C
+c      NAC : number of columns for matrix  A and number of rows
+c                              for matrix  B
+c      NBC : number of columns for matrix  B and  matrix  C
+c
+c
+       IMPLICIT NONE
+c
+       INTEGER  NAR,NAC,NBC, I,J,K
+       REAL     A(NAR,NAC), B(NAC,NBC), C(NAR,NBC)
+c
+       DO 10 J = 1,NBC
+       DO 10 I = 1,NAR
+       C(I,J)=0.
+10     CONTINUE
+c
+       DO 50 J = 1,NBC
+       DO 40 I = 1,NAR
+
+       DO 20 K = 1,NAC
+       C(I,J)  = C(I,J) + A(I,K) * B(K,J)
+20     CONTINUE
+
+40     CONTINUE
+50     CONTINUE
+
+       RETURN
+       END
Index: /trunk/LMDZ.MARS/libf/misc/mxv.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/mxv.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/mxv.F	(revision 1403)
@@ -0,0 +1,20 @@
+      SUBROUTINE MXV(A,NRA,B,NCA,C)
+      IMPLICIT NONE
+
+      INTEGER NRA,NCA
+      REAL A(NRA,NCA), B(NCA), C(NRA)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+         C(I) = 0.
+100   CONTINUE
+c     multiply matrix A and vector B
+      DO 220 J = 1, NCA
+         DO 210 I = 1, NRA
+            C(I) = C(I) + A(I,J)*B(J)
+210     CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/misc/mxva.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/mxva.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/mxva.F	(revision 1403)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(*), SB(*), SC(*)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/misc/mywrite.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/mywrite.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/mywrite.F	(revision 1403)
@@ -0,0 +1,154 @@
+      SUBROUTINE mywrite(champ,icount,titre,unit,format,nom
+     &                  , entete, date0, date, deltpas, nbeta
+     &                  , deltajour, filenum, files)
+C----------------------------------------------------------
+C Subroutine qui ecrit les fichiers dans le format de transfert
+C vers le LMD.
+C format etabli par Zhao-Xin Li, Frederique Hourdin, Emmanuelle Cohen-Solal,
+C Jan Polcher . Il peut etre utilise pour sortire  des evolutions
+C temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+C le character # place devant le format determine la fin de la 
+C description du champ et permet eventulellement de rajouter
+C des informations (avant le #).
+C le programme de lecture lit , dans la description, les variables
+C qu'il connait et saute apres jusquau #. A partir de la
+C il commence a lire le champ dans le format specifie.
+c------------------------------------------------------------
+C       ARGUMENTS
+C       +++++++++
+C champ: REAL (icount)
+C        champ contenant les valeurs et de longeur icount
+C icount: INTEGER
+C         nombre d'element dans le champ
+C titre: CHARACTER*100
+C        nom d'ecrivant le champ
+C unit: CHARACTER*20
+C       unites du champ
+C format: CHARACTER*20
+C         format dans le quel le champ doit etre ecrit.
+C         au choix:
+C                  - tous les format FORTRAN
+C                  - compactage de L.Li (zxliN) ou N peut valoir 1, 2 ou 3
+C nom: CHARACTER*20
+C      nom du fichier dans le quel le champ sera ecris, eventuellement
+C      avec directory (ex: evol/tsol)
+C entete: CHARACTER*100
+C         une entete du fichier pouvant par exemple decrire le run
+C date0: CHARACTER*8
+C        date de depart de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C date : CHARACTER*8
+C        date de fin de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C deltpas: INTEGER (bandmax)
+C          decript le nombre de pas de temps entre deux sorties pour chamque
+C          bande (necesaire pour les evolutions temporelles)
+C nbeta: INTEGER (bandmax)
+C        donne le nombre d'etas par bande (necesaire pour les evolutions 
+C        temporelles)
+C deltajour: REAL (bandmax)
+C             l'ecart en jours des iscriptions sur chaque bande (necesaire 
+C             pour les evolutions temporelles)
+C filenum: INTEGER
+C          nombre d'elements dans la liste files des champs desires
+C          si filenum = 0 alors tous les champs sont sortis  
+C files: CHARACTER*20 (100)
+C        list des champ que l'on desire sortire
+C
+C        PARAMETER
+C        +++++++++
+C bandmax: INTEGER
+C          le nombre maximale que peut traiter le programme
+C
+
+
+      IMPLICIT NONE
+
+      INTEGER bandmax
+      PARAMETER (bandmax = 24)
+      INTEGER icount,i,imin,imax
+      REAL champ(icount)
+      CHARACTER*100 titre, entete
+      CHARACTER unit*20,nom*80
+      CHARACTER*20 format
+      CHARACTER*8 date0, date
+      INTEGER deltpas(bandmax), nbeta(bandmax)
+      REAL deltajour(bandmax)
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      INTEGER filenum
+      CHARACTER*20 files(100)
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      check = .FALSE.
+
+      IF (filenum .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(nom,writeornot,filenum, files)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+      IF (writeornot) THEN
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) entete(1:lnblnk(entete))
+        WRITE(*,*) titre(1:lnblnk(titre))
+        WRITE(*,*) date0
+        WRITE(*,*) date
+        WRITE(*,*) unit(1:lnblnk(unit))
+        WRITE(*,*) deltpas, nbeta
+        WRITE(*,*) deltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) format(1:lnblnk(format))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) titre(1:lnblnk(titre)),'min,max:',
+     &           champ(imin),champ(imax),'  ',unit(1:lnblnk(unit))
+      
+      OPEN (unit=55, file=nom(1:lnblnk(nom)))
+      WRITE(55,'(a)') entete(1:lnblnk(entete))
+      WRITE(55,'(a)') titre(1:lnblnk(titre))
+      WRITE(55,'(a)') date0
+      WRITE(55,'(a)') date
+      WRITE(55,'(a)') unit(1:lnblnk(unit))
+      WRITE(55,*) deltpas, nbeta
+      WRITE(55,*) deltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//format(1:lnblnk(format))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//format(1:lnblnk(format))//')') champ(1)
+      ENDIF
+
+      IF (format(1:lnblnk(format)) .EQ. 'zxli1') THEN
+        CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+      ELSE 
+        IF (format(1:lnblnk(format)) .EQ. 'zxli2') THEN
+          CALL to36 (champ, icount,champ(imin), champ(imax),55, 2)
+        ELSE
+          IF (format(1:lnblnk(format)) .EQ. 'zxli3') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 3)
+          ELSE
+            DO 2233 i=1,icount
+              WRITE(55,'('//format(1:lnblnk(format))//')') 
+     &             champ(i)
+ 2233       CONTINUE
+          ENDIF
+        ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      ELSE
+        WRITE(*,*) 'FILE    ',nom,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: /trunk/LMDZ.MARS/libf/misc/readcoord.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/readcoord.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/readcoord.F	(revision 1403)
@@ -0,0 +1,123 @@
+      SUBROUTINE readcoord(imx,jmx,lmx,imax,jmax,lmax,x,y,z,pathcoor)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs Jan Polcher, Frederic Hourdin
+c   -------
+c
+c   Objet   Lecture du fichier contenant des coordonnees x,y et z.
+c   -----
+c
+c   Inteface
+c   --------
+c
+c   Arguments:
+c   ----------
+c
+c   input
+c   -----
+c      imx   \
+c      jmx          dimensions des coordonnees
+c      lmx   /
+c      pathcoor     path absolu pour le fichier des coordonnees
+c                   CHARACTER*80
+c
+c   ouput
+c   -----
+c      imax         nombre de coordonnees x effectives
+c      jmax         nombre de coordonnees y effectives
+c      lmax         nombre de coordonnees z effectives
+c      x(imx)
+c      y(jmx)
+c      z(lmx)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+      INTEGER imx,jmx,lmx
+      INTEGER imax,jmax,lmax
+
+      REAL x(imx),y(jmx),z(lmx)
+
+      CHARACTER*80 pathcoor
+
+c   local
+c   -----
+
+      INTEGER i,j,l
+
+      CHARACTER*100 filecoor,messerr
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      messerr=' '
+      filecoor='coord.def'
+
+c-----------------------------------------------------------------------
+
+100   IF(pathcoor(1:1).EQ.'/') THEN
+         filecoor= pathcoor(:lnblnk(pathcoor))//filecoor
+      ENDIF
+      OPEN (99,file=filecoor,err=200,status='old',form='formatted')
+      GO TO 300
+
+200   WRITE(*,*) messerr
+      WRITE(*,*) 'entrer le nom du fichier des coordonnees puis RETURN'
+      WRITE(*,*) 'ou seulement RETURN pour arreter le programme'
+      READ(*,'(a)') filecoor
+      IF(filecoor(1:1).EQ.' ') STOP
+      CLOSE (99)
+      GOTO 100
+
+300   CONTINUE
+
+      READ(99,*,err=9999) imax
+      IF(imax.GT.imx) THEN
+        WRITE(6,1000) 'x',imx,imax
+        STOP
+      ENDIF
+      READ(99,*) (x(i),i=1,imax)
+
+      READ(99,*,err=9999) jmax
+      IF(jmax.GT.jmx) THEN
+        WRITE(6,1000) 'y',jmx,jmax
+        STOP
+      ENDIF
+      READ(99,*,err=9999) (y(j),j=1,jmax)
+
+      READ(99,*,err=9999) lmax
+      IF(lmax.GT.lmx) THEN
+        WRITE(6,1000) 'z',lmx,lmax
+        STOP
+      ENDIF
+      READ(99,*) (z(l),l=1,lmax)
+
+      CLOSE(99)
+
+c-----------------------------------------------------------------------
+
+      RETURN
+
+9999  PRINT*,'Le fichier ',filecoor,' que vous lisez est mal structure'
+      PRINT*,'Il doit contenir :'
+      PRINT*,'  le nombre de points en x suivi des valeurs de x'
+      PRINT*,'  puis la meme chose pour y et z'
+      STOP
+
+1000  FORMAT(/,
+     $ 'Probleme avec le fichier de coordonnees',/,
+     $ 'Le tableau contenant ',a3,' est dimenssionne a ',i4,/,
+     $ 'et le fichier de coordonnees contient ',i4,' valeurs.')
+
+      END
Index: /trunk/LMDZ.MARS/libf/misc/readstd.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/readstd.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/readstd.F	(revision 1403)
@@ -0,0 +1,286 @@
+      SUBROUTINE readstd(imx,champ,imax)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin  20/04/91
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui lit les fichiers dans le format lmdstd
+c format etabli par :
+c  Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c imx  : INTEGER
+c        taille du tableau contenant le champ
+c champ: REAL (imx)
+c        champ contenant les valeurs et de longeur icount
+c imax : INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER imx,imax
+      REAL champ(imx)
+
+c   Local:
+c   ------
+
+      INTEGER i
+
+      CHARACTER*200 test(20)
+      CHARACTER*200 helptest(20)
+      CHARACTER*200 help
+      INTEGER reccount
+
+      LOGICAL check,continue
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      check = .FALSE.
+      DO 9876 i=1,20
+        helptest(i) = '        '
+ 9876 CONTINUE
+
+
+c-----------------------------------------------------------------------
+c   lecture le l'entete:
+c   --------------------
+
+ 2222 OPEN (unit=10,file=gfichier(1:lnblnk(gfichier)), form='formatted',
+     &      ERR = 9999, status='old')
+      GOTO 1111
+
+ 9999 WRITE(*,*) 'Je ne peut pas lire le fichier: ',
+     & gfichier(1:lnblnk(gfichier))
+      CLOSE(10)
+      WRITE(*,*) 'Entrez S.V.P. un autre nom de fichier (path absolu) '
+      WRITE(*,*) 'ou RETURN pour stopper lexecution'
+      READ (*,'(a)') gfichier
+      IF(lnblnk(gfichier).EQ.0) STOP
+      GOTO 2222
+
+ 1111 continue = .TRUE.
+      DO 2345 i=1,20
+        IF (continue) THEN
+          READ (10,'(a200)') test(i)
+          IF ( test(i)(1:1) .EQ. '#' .OR. test(i)(1:1) .EQ. 'f10' ) THEN
+            continue = .FALSE.
+            reccount = i
+          ENDIF
+        ENDIF
+ 2345 CONTINUE
+
+      DO 1223 i=1,reccount-1
+        helptest(i) = test(i)
+ 1223 CONTINUE
+      helptest(20) = test(reccount)
+
+
+      IF (check) THEN
+        WRITE(*,*) 'gentete'
+      ENDIF
+      IF ( helptest(1) .NE. ' ' ) THEN
+        read (helptest(1),'(a100)') gentete
+      ELSE
+c       WRITE(*,*) 'la description du run'
+c       READ (*,'(a100)') gentete
+        gentete = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'titre'
+      ENDIF
+      IF ( helptest(2) .NE. ' ' ) THEN
+        read (helptest(2),'(a100)') gtitre
+      ELSE
+c       WRITE(*,*) 'le titre du dessin'
+c       READ (*,'(a100)') gtitre 
+        gtitre = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'datefins'
+      ENDIF
+      IF ( helptest(3) .NE. ' ' ) THEN
+        read (helptest(3),'(a8)') gdatedep 
+        read (helptest(4),'(a8)') gdatefin
+      ELSE
+c       WRITE(*,*)
+c    &  'datefin du debut de la moyenne (ou le mois tout simplement)'
+c       READ (*,'(a8)') gdatedep 
+c       WRITE(*,*) 'et celle de la fin (ou rien du tout)'
+c       READ (*,'(a8)') gdatefin 
+        gdatedep = '       '
+        gdatefin = '       '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'unitees'
+      ENDIF
+      IF ( helptest(5) .NE. ' ' ) THEN
+        read (helptest(5),'(a20)') gunites
+      ELSE
+c       WRITE(*,*) 'les unitees du champ'
+c       READ (*,'(a20)') gunites
+        gunites = '                    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltapas et nbetats'
+      ENDIF
+      IF ( helptest(6) .NE. ' ' ) THEN
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+        GOTO 1213
+
+ 1212   help =helptest(6)(1:lnblnk(helptest(6)))//
+     .        helptest(7)(1:lnblnk(helptest(7)))
+        helptest(6) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1214 i=7,reccount
+          helptest(i) = helptest(i+1)
+ 1214   CONTINUE
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+
+ 1213   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltajour'
+      ENDIF
+      IF ( helptest(7) .NE. ' ' ) THEN
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+        GOTO 1313
+
+ 1312   help =helptest(7)(1:lnblnk(helptest(7)))//
+     .        helptest(8)(1:lnblnk(helptest(8)))
+        helptest(7) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1314 i=8,reccount
+          helptest(i) = helptest(i+1)
+ 1314   CONTINUE
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+
+ 1313   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'min et max'
+      ENDIF
+      IF ( helptest(8) .NE. ' ' ) THEN
+c       READ (helptest(8),*)     gminimum,gmaximum
+      ENDIF
+
+      gformat = helptest(20)(2:20)
+
+      IF (check) THEN
+        WRITE(*,*) gentete
+        WRITE(*,*) gtitre
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin 
+        WRITE(*,*) gdeltapas,gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) gminimum,gmaximum
+        WRITE(*,*) gformat
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   lecture du champ proprement dit:
+c   --------------------------------
+
+      READ (10,*)     imax
+   
+      IF(imax.GT.imx) THEN
+         WRITE(*,*) 'Vous essayez de lire un champ dont la taille est'
+         WRITE(*,*) 'superieure a la taille maximum autorisee'
+         WRITE(*,*) 'c est a dire a la dimension du champ utilise'
+         WRITE(*,*) 'pour lappel a la procedure writestd.'
+         STOP
+      ENDIF
+
+      IF (gformat(1:4) .EQ. 'zxli') THEN
+        CALL from36 (champ,imax,10)
+      ELSE 
+         IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+            READ(10,*) (champ (i),i=1,imax)
+         ELSE
+            READ(10,'('//gformat(1:lnblnk(gformat))//')')
+     $      (champ (i),i=1,imax)
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=10)
+
+
+      RETURN
+      END
Index: /trunk/LMDZ.MARS/libf/misc/scatter.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/scatter.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/scatter.F	(revision 1403)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: /trunk/LMDZ.MARS/libf/misc/scopy.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/scopy.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/scopy.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/scopyi.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/scopyi.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/scopyi.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/sdot.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/sdot.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/sdot.F	(revision 1403)
@@ -0,0 +1,21 @@
+      FUNCTION sdot (n, x,incx, y,incy)
+      IMPLICIT NONE
+c
+      integer n, incx, incy
+      real sdot
+      real x((n-1)*incx+1), y((n-1)*incy+1)
+c
+      integer i, ix, iy
+c
+      sdot = 0.0
+      ix = 1
+      iy = 1
+c
+      do 10 i = 1, n
+         sdot = sdot + x(ix) * y(iy)
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/ssum.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/ssum.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/ssum.F	(revision 1403)
@@ -0,0 +1,16 @@
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+      ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/to36.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/to36.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/to36.F	(revision 1403)
@@ -0,0 +1,84 @@
+      SUBROUTINE to36(x,nbre,xmin,xmax,iunit,icase)
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c=======================================================================
+c-- x    : le champ a compacter
+c-- nbre : la taille du champ x
+c-- iunit: numero logique du fichier sortie
+c-- icase: nombre de cases a utiliser (qui determine la precision)
+      INTEGER iunit, nbre, icase
+      REAL x(nbre) 
+c=======================================================================
+      INTEGER ibase, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxnbr=100000)
+      PARAMETER (ifact1 = ibase**1-1)
+      PARAMETER (ifact2 = ibase**2-1)
+      PARAMETER (ifact3 = ibase**3-1)
+c=======================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*1 chax1(maxnbr)
+c======================================================================
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*2 chax2(maxnbr)
+c======================================================================
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+      CHARACTER*3 chax3(maxnbr)
+c=====================================================================
+      INTEGER i, inte
+      REAL xmin, xmax
+      EXTERNAL ini36
+c=====================================================================
+c
+c--- initialisation pour le codage
+c la routine ini36 est appelee une seule fois
+c     IF (word1(36) .NE. 'Z' ) THEN
+        CALL ini36
+c     ENDIF
+
+      IF (nbre .GT. maxnbr) THEN
+        PRINT*, 'Nombre elements trop grand', nbre, maxnbr
+        STOP
+      ENDIF
+c
+      WRITE(iunit,*) nbre, ibase, icase, '  (nbre,ibase,icase)'
+      WRITE(iunit,*) xmin
+      WRITE(iunit,*) xmax
+c
+      IF(xmin .EQ. xmax)THEN
+      WRITE(iunit,'(a)')'Ce champ est constant'
+      GO TO 999
+      ENDIF 
+c
+      IF (icase .EQ. 1) THEN
+        DO 10 i = 1, nbre
+          inte = NINT( FLOAT(ifact1)/(xmax-xmin) * (x(i)-xmin) )
+          chax1(i) = word1(inte)
+   10   CONTINUE
+        WRITE(iunit,91) (chax1(i),i=1,nbre)
+      ELSE IF (icase .EQ. 2) THEN
+        DO 20 i = 1, nbre
+          inte = NINT( FLOAT(ifact2)/(xmax-xmin) * (x(i)-xmin) )
+          chax2(i) = word2(inte)
+   20   CONTINUE
+        WRITE(iunit,92) (chax2(i),i=1,nbre)
+      ELSE IF (icase.eq.3) THEN
+        DO 30 i = 1, nbre
+          inte = NINT( FLOAT(ifact3)/(xmax-xmin) * (x(i)-xmin) )
+          chax3(i) = word3(inte)
+   30   CONTINUE
+        WRITE(iunit,93) (chax3(i),i=1,nbre)
+      ELSE
+        PRINT*, 'Verfier icase (1,2,3) dans les arguments de to36'
+        STOP
+      ENDIF
+c
+   91 FORMAT(120a1)
+   92 FORMAT(64a2)
+   93 FORMAT(40a3)
+c
+  999 RETURN
+      END 
+
Index: /trunk/LMDZ.MARS/libf/misc/wheneq.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/wheneq.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/wheneq.F	(revision 1403)
@@ -0,0 +1,23 @@
+      SUBROUTINE wheneq(n,x,incx,target,index,nn)
+      IMPLICIT NONE
+c
+      integer n, incx, nn
+      integer index(n)
+c
+      integer target, x((n-1)*incx+1)
+cccccc      real target, x((n-1)*incx+1)
+c
+      integer i, ix
+c
+      ix = 1
+      nn = 0
+      do 10 i = 1, n
+         if (x(ix).EQ.target) then
+            index(i) = ix
+            nn = nn + 1
+         endif
+         ix = ix + incx
+   10 continue
+c
+      return
+      end
Index: /trunk/LMDZ.MARS/libf/misc/writestd.F
===================================================================
--- /trunk/LMDZ.MARS/libf/misc/writestd.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/misc/writestd.F	(revision 1403)
@@ -0,0 +1,200 @@
+      SUBROUTINE writestd(champ,icount)
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui ecrit les fichiers dans le format de transfert
+c vers le LMD.
+c format etabli par :
+c   Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c   Jan Polcher .
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c champ: REAL (icount)
+c        champ contenant les valeurs et de longeur icount
+c icount: INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER icount
+      REAL champ(icount)
+
+c   Local:
+c   ------
+
+      INTEGER i,imin,imax
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      INTEGER indexfil
+      COMMON/indexfil/indexfil
+
+c-----------------------------------------------------------------------
+c   verification que le champ est dans la liste predefinie:
+c   -------------------------------------------------------
+
+      check = .FALSE.
+
+      IF (gnbfich .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(gfichier,writeornot,gnbfich, glistfich)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+c-----------------------------------------------------------------------
+      IF (writeornot) THEN
+c-----------------------------------------------------------------------
+
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) gentete(1:lnblnk(gentete))
+        WRITE(*,*) gtitre(1:lnblnk(gtitre))
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin
+        WRITE(*,*) gunites(1:lnblnk(gunites))
+        WRITE(*,*) gdeltapas, gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) gformat(1:lnblnk(gformat))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) gtitre(1:lnblnk(gtitre)),'min,max:',
+     &  champ(imin),champ(imax),'  ',gunites(1:lnblnk(gunites))
+      
+c-----------------------------------------------------------------------
+c   creation eventuelle d'un nom pour le fichier d'ecriture du champ:
+c   -----------------------------------------------------------------
+
+      IF(lnblnk(gfichier).LT.1.OR.lnblnk(gfichier).GE.100) THEN
+         gfichier(1:5)='champ'
+         IF(indexfil.LT.1) indexfil=49
+         gfichier(6:6)=char(indexfil)
+	 indexfil=indexfil+1
+	 PRINT*,'nom du fichier  ',gfichier
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   ecriture sur le fichier de sorties:
+c   -----------------------------------
+
+      OPEN (unit=55, file=gfichier(1:lnblnk(gfichier)))
+      WRITE(55,'(a)') gentete(1:lnblnk(gentete))
+      WRITE(55,'(a)') gtitre(1:lnblnk(gtitre))
+      WRITE(55,'(a)') gdatedep
+      WRITE(55,'(a)') gdatefin
+      WRITE(55,'(a)') gunites(1:lnblnk(gunites))
+      WRITE(55,*) gdeltapas, gnbetats
+      WRITE(55,*) gdeltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//gformat(1:lnblnk(gformat))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//gformat(1:lnblnk(gformat))//')') champ(1)
+      ENDIF
+
+      IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+         DO 2230 i=1,icount
+            WRITE(55,*) champ(i)
+2230     CONTINUE
+      ELSE
+         IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli1') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55,1)
+         ELSE 
+            IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli2') THEN
+            CALL to36(champ,icount,champ(imin),champ(imax),55,2)
+            ELSE
+               IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli3') THEN
+            CALL to36(champ,icount,champ(imin),champ(imax),55,3)
+               ELSE
+                  WRITE(55,'('//gformat(1:lnblnk(gformat))//')') 
+     &            (champ(i),i=1,icount)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      gfichier=' '
+
+c-----------------------------------------------------------------------
+c   si on ecrit pas le champ (writeornot.EQ..f.):
+c   ---------------------------------------------
+
+      ELSE
+        WRITE(*,*) 'FILE    ',gfichier,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: unk/LMDZ.MARS/libf/phymars/datareadnc.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/datareadnc.F	(revision 1402)
+++ 	(revision )
@@ -1,311 +1,0 @@
-c=======================================================================
-      SUBROUTINE datareadnc(relief,phisinit,alb,ith,z0,
-     &                    zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c
-c
-c   Author: F. Hourdin      01/1997
-c   -------
-c
-c   Object: To read data from Martian surface to use in a GCM
-c   ------                from NetCDF file "surface.nc"
-c
-c
-c   Arguments:
-c   ----------
-c
-c     Inputs:
-c     ------
-c
-c     Outputs:
-c     --------
-c
-c=======================================================================
-c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
-c
-c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
-c
-c   360 valeurs en longitude (de -179.5 a 179.5)
-c   180 valeurs en latitudes (de 89.5 a -89.5)
-c
-c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
-c
-c   Il faut donc que ces donnees soient au format grille scalaire
-c               (imold+1 jmold+1)
-c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
-c
-c   On prend imd (d pour donnees!) 
-c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
-c                   (rlonud de -179 a -181)
-c           jmd = 179 
-c                   (rlatvd de 89 a -89)
-c=======================================================================
-
-! to use  'getin'
-       use ioipsl_getincom 
-
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comconst.h"
-#include "netcdf.inc"
-#include "datafile.h"
-
-c=======================================================================
-c   Declarations:
-C=======================================================================
-
-      INTEGER    imd,jmd,imdp1,jmdp1
-      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
-
-      INTEGER    iimp1
-      parameter    (iimp1=iim+1-1/iim)
-
-! Arguments:
-      CHARACTER(len=3),intent(inout) :: relief
-      REAL,intent(out) :: phisinit(iimp1*jjp1)
-      REAL,intent(out) :: alb(iimp1*jjp1)
-      REAL,intent(out) :: ith(iimp1*jjp1)
-      REAL,intent(out) :: z0(iimp1*jjp1)
-      REAL,intent(out) :: zmea(imdp1*jmdp1)
-      REAL,intent(out) :: zstd(imdp1*jmdp1)
-      REAL,intent(out) :: zsig(imdp1*jmdp1)
-      REAL,intent(out) :: zgam(imdp1*jmdp1)
-      REAL,intent(out) :: zthe(imdp1*jmdp1)
-
-! Local variables:
-      REAL        zdata(imd*jmdp1)
-      REAL        zdataS(imdp1*jmdp1)
-      REAL        pfield(iimp1*jjp1)
-
-      INTEGER     ierr
-
-      INTEGER   unit,nvarid
-
-      INTEGER    i,j,k
-
-      INTEGER klatdat,ngridmxgdat
-      PARAMETER (klatdat=180,ngridmxgdat=360)
-
-c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
-
-      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
-      REAL rlonud(imdp1),rlatvd(jmd)
-
-      CHARACTER*20 string
-      DIMENSION string(0:4)
-
-
-!#include "lmdstd.h"
-#include "fxyprim.h"
-
-      pi=2.*ASIN(1.)
-
-c=======================================================================
-c    rlonud, rlatvd
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF des donnees latitude et longitude
-c-----------------------------------------------------------------------
-      write(*,*) 'datareadnc: opening file surface.nc'
-
-      datafile="/u/lmdz/WWW/planets/mars/datadir" ! default path to surface.nc
-      call getin("datadir",datafile) ! but users may specify another path
-      
-      ierr = NF_OPEN (trim(datafile)//'/surface.nc',
-     &  NF_NOWRITE,unit)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(*,*)'Error : cannot open file surface.nc '
-        write(*,*)'(in phymars/datareadnc.F)'
-        write(*,*)'It should be in :',trim(datafile),'/'
-        write(*,*)'1) You can set this path in the 
-     & callphys.def file:'
-        write(*,*)'   datadir=/path/to/the/datafiles'
-        write(*,*)'2) If necessary, surface.nc (and other datafiles)'
-        write(*,*)'   can be obtained online on:'
-        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
-        CALL ABORT
-      ENDIF
-
-c
-c Lecture des latitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
-#endif
-c
-c Lecture des longitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
-#endif
-
-c-----------------------------------------------------------------------
-c    Passage au format boites scalaires
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c       longitude(imd)        -->      rlonud(imdp1) 
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do i=1,imd 
-          rlonud(i)=(longitude(i)+.5)*pi/180.
-      enddo
-
-c Repetition de la valeur im+1
-      rlonud(imdp1)=rlonud(1) + 2*pi
-
-c-----------------------------------------------------------------------
-c        latitude(jmdp1)         -->        rlonvd(jmd)
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do j=1,jmd 
-          rlatvd(j)=(latitude(j)-.5)*pi/180.
-      enddo
-
-c=======================================================================
-c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
-c=======================================================================
-
-      string(0) = 'z0'
-      string(1) = 'albedo'
-      string(2) = 'thermal'
-      if (relief.ne.'pla') then
-        write(*,*) ' MOLA topography'
-        relief = 'MOL'
-          string(3) = 'z'//relief
-      else
-          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
-                            ! remise a 0 derriere
-      endif
-      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
- 
-
-      DO k=0,4
-          write(*,*) 'string',k,string(k)
-          
-c-----------------------------------------------------------------------
-c    initialisation
-c-----------------------------------------------------------------------
-      call initial0(iimp1*jjp1,pfield)
-      call initial0(imd*jmdp1,zdata)
-      call initial0(imdp1*jmdp1,zdataS)
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF  
-c-----------------------------------------------------------------------
-
-      ierr = NF_INQ_VARID (unit, string(k), nvarid)
-      if (ierr.ne.nf_noerr) then
-        write(*,*) 'datareadnc error, cannot find ',trim(string(k))
-        write(*,*) ' in file ',trim(datafile),'/surface.nc'
-        stop
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
-#endif
-      if (ierr.ne.nf_noerr) then
-        write(*,*) 'datareadnc: error failed loading ',trim(string(k))
-        stop
-      endif
-
-c-----------------------------------------------------------------------
-c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
-c-----------------------------------------------------------------------
-      if (k.eq.4) then
-
-          call multscal(imd*jmdp1,zdata,1000.,zdata)
-          call multscal(imd,longitude,pi/180.,longitude)
-          call multscal(jmdp1,latitude,pi/180.,latitude)
-
-          call grid_noro1(360, 180, longitude, latitude, zdata,
-     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
-
-          CALL dump2d(iip1,jjp1,zmea,'zmea')
-          CALL dump2d(iip1,jjp1,zstd,'zstd')
-          CALL dump2d(iip1,jjp1,zsig,'zsig')
-          CALL dump2d(iip1,jjp1,zgam,'zgam')
-          CALL dump2d(iip1,jjp1,zthe,'zthe')
-
-      endif
-
-c-----------------------------------------------------------------------
-c   Passage de zdata en grille (imdp1 jmdp1)
-c-----------------------------------------------------------------------
-      do j=1,jmdp1
-          do i=1,imd
-              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
-          enddo
-          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
-      enddo
-
-c-----------------------------------------------------------------------
-c    Interpolation
-c-----------------------------------------------------------------------
-      call interp_horiz(zdataS,pfield,imd,jmd,
-     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
-
-c-----------------------------------------------------------------------
-c    Periodicite    
-c-----------------------------------------------------------------------
-
-      do j=1,jjp1
-         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
-      enddo 
- 
-c-----------------------------------------------------------------------
-c    Sauvegarde des champs    
-c-----------------------------------------------------------------------
-
-      if (k.eq.0) then                    ! z0
-         z0(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)*.01
-         ! multiplied by 0.01 to have z0 in m
-         CALL dump2d(iimp1,jjp1,z0,'z0 in m')
-      elseif (k.eq.1) then                    ! albedo
-         do i=1,iimp1*jjp1
-              alb(i) = pfield(i)
-          enddo
-      elseif (k.eq.2) then                ! thermal
-         do i=1,iimp1*jjp1
-              ith(i) = pfield(i)
-          enddo
-      elseif (k.eq.3) then                ! relief
-        if (relief.eq.'pla') then
-              call initial0(iimp1*jjp1,phisinit)
-        else
-             do i=1,iimp1*jjp1
-                  phisinit(i) = pfield(i)
-              enddo
-        endif
-      endif
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c    Traitement Phisinit
-c-----------------------------------------------------------------------
-
-      DO i=1,iimp1*jjp1
-            phisinit(i)=1000.*phisinit(i)
-      ENDDO
-      CALL dump2d(iimp1,jjp1,phisinit,'Altitude in m')
-      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
-
-c-----------------------------------------------------------------------
-c    FIN
-c-----------------------------------------------------------------------
-
-      END
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comconst.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comgeom.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comvert.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/control_mod.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/description.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/ener.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/infotrac.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/logic.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/mod_const_mpi.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_para.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/paramet.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/serre.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/temps.h
Index: /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1403)
+++ /trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1403)
@@ -0,0 +1,830 @@
+
+      PROGRAM testphys1d
+! to use  'getin'
+      USE ioipsl_getincom, only: getin
+      use infotrac, only: nqtot, tname
+      use comsoil_h, only: volcapa, layer, mlayer, inertiedat, nsoilmx
+      use comgeomfi_h, only: lati, long, area, sinlat, ini_fillgeom
+      use surfdat_h, only: albedodat, z0_default, emissiv, emisice,
+     &                     albedice, iceradius, dtemisice, z0,
+     &                     zmea, zstd, zsig, zgam, zthe, phisfi,
+     &                     watercaptag
+      use slope_mod, only: theta_sl, psi_sl
+      use control_mod, only: day_step
+      use phyredem, only: physdem0,physdem1
+      use comgeomphy, only: initcomgeomphy
+      use planete_h, only: year_day, periheli, aphelie, peri_day,
+     &                     obliquit, emin_turb, lmixmin
+      use comcstfi_h, only: pi, rad, daysec, omeg, g, mugaz, rcp, r,
+     &                      cpp, dtphys
+      use dimradmars_mod, only: tauscaling,tauvis
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the martian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 25 layers)
+c  "makegcm -p mars -d 25 testphys1d"
+c It requires the files "testphys1d.def" "callphys.def"
+c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget
+c   -------
+c   
+c   update: 12/06/2003 including chemistry (S. Lebonnois) 
+c                            and water ice (F. Montmessin)
+c 
+c=======================================================================
+
+#include "dimensions.h"
+      integer, parameter :: ngrid = 1 !(2+(jjm-1)*iim - 1/jjm)
+      integer, parameter :: nlayer = llm
+!#include "dimradmars.h"
+!#include "comgeomfi.h"
+!#include "surfdat.h"
+!#include "slope.h"
+!#include "comsoil.h"
+!#include "comdiurn.h"
+#include "callkeys.h"
+!#include "comsaison.h"
+!#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "comg1d.h"
+#include "logic.h"
+!#include "advtrac.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(nlayer)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(nlayer+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf(1)      
+      REAL u(nlayer),v(nlayer)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(nlayer)   ! temperature at the middle of the layers
+      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL,ALLOCATABLE :: qsurf(:) ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+      REAL co2ice(1)        ! co2ice layer (kg.m-2)
+      REAL emis(1)          ! surface layer
+      REAL q2(nlayer+1)   ! Turbulent Kinetic Energy
+      REAL zlay(nlayer)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(nlayer),dv(nlayer),dtemp(nlayer)
+      REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer)
+      REAL dpsurf    
+      REAL,ALLOCATABLE :: dq(:,:)
+      REAL,ALLOCATABLE :: dqdyn(:,:)
+
+c   Various intermediate variables
+      INTEGER thermo
+      REAL zls
+      REAL phi(nlayer),h(nlayer),s(nlayer)
+      REAL pks, ptif, w(nlayer)
+      REAL qtotinit,qtot
+      real,allocatable :: mqtot(:)
+      INTEGER ierr, aslun
+      REAL tmp1(0:nlayer),tmp2(0:nlayer)
+      Logical  tracerdyn
+      integer :: nq=1 ! number of tracers
+      real :: latitude(1), longitude(1)
+
+      character*2 str2
+      character (len=7) :: str7
+      character(len=44) :: txt
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+! initialize "serial/parallel" related stuff
+!      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+c ------------------------------------------------------
+c  Prescribed constants to be set here
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Mars planetary constants
+c     ----------------------------
+      rad=3397200.               ! mars radius (m)  ~3397200 m
+      daysec=88775.              ! length of a sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)  ! rotation rate (rad.s-1)
+      g=3.72                     ! gravity (m.s-2) ~3.72  
+      mugaz=43.49                ! atmosphere mola mass (g.mol-1) ~43.49
+      rcp=.256793                ! = r/cp  ~0.256793
+      r= 8.314511E+0 *1000.E+0/mugaz
+      cpp= r/rcp
+      year_day = 669             ! lenght of year (sols) ~668.6
+      periheli = 206.66          ! minimum sun-mars distance (Mkm) ~206.66
+      aphelie = 249.22           ! maximum sun-mars distance (Mkm) ~249.22
+      peri_day =  485.           ! perihelion date (sols since N. Spring)
+      obliquit = 25.2            ! Obliquity (deg) ~25.2         
+ 
+c     Planetary Boundary Layer and Turbulence parameters 
+c     --------------------------------------------------
+      z0_default =  1.e-2        ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! minimal turbulent energy ~1.e-8
+      lmixmin = 30               ! mixing length ~100
+ 
+c     cap properties and surface emissivities
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Bare ground emissivity ~.95
+      emisice(1)=0.95            ! Northern cap emissivity
+      emisice(2)=0.95            ! Southern cap emisssivity
+      albedice(1)=0.5            ! Northern cap albedo
+      albedice(2)=0.5            ! Southern cap albedo
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+
+
+c ------------------------------------------------------
+c  Loading run parameters from "run.def" file
+c ------------------------------------------------------
+
+
+! check if 'run.def' file is around (otherwise reading parameters
+! from callphys.def via getin() routine won't work.
+      open(99,file='run.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.ne.0) then
+        write(*,*) 'Cannot find required file "run.def"'
+        write(*,*) '  (which should contain some input parameters'
+        write(*,*) '   along with the following line:'
+        write(*,*) '   INCLUDEDEF=callphys.def'
+        write(*,*) '   )'
+        write(*,*) ' ... might as well stop here ...'
+        stop
+      else
+        close(99)
+      endif
+
+! check if we are going to run with or without tracers
+      write(*,*) "Run with or without tracer transport ?"
+      tracer=.false. ! default value
+      call getin("tracer",tracer)
+      write(*,*) " tracer = ",tracer
+
+! while we're at it, check if there is a 'traceur.def' file
+! and process it.
+      if (tracer) then
+      ! load tracer names from file 'traceur.def'
+        open(90,file='traceur.def',status='old',form='formatted',
+     &       iostat=ierr)
+        if (ierr.ne.0) then
+          write(*,*) 'Cannot find required file "traceur.def"'
+          write(*,*) ' If you want to run with tracers, I need it'
+          write(*,*) ' ... might as well stop here ...'
+          stop
+        else
+          write(*,*) "testphys1d: Reading file traceur.def"
+          ! read number of tracers:
+          read(90,*,iostat=ierr) nq
+          nqtot=nq ! set value of nqtot (in infotrac module) as nq
+          if (ierr.ne.0) then
+            write(*,*) "testphys1d: error reading number of tracers"
+            write(*,*) "   (first line of traceur.def) "
+            stop
+          endif
+        endif
+        ! allocate arrays:
+        allocate(tname(nq))
+        allocate(q(nlayer,nq))
+        allocate(qsurf(nq))
+        allocate(dq(nlayer,nq))
+        allocate(dqdyn(nlayer,nq))
+        allocate(mqtot(nq))
+        
+        ! read tracer names from file traceur.def
+        do iq=1,nq
+          read(90,*,iostat=ierr) tname(iq)
+          if (ierr.ne.0) then
+            write(*,*) 'testphys1d: error reading tracer names...'
+            stop
+          endif
+        enddo
+        close(90)
+
+        ! initialize tracers here:
+        write(*,*) "testphys1d: initializing tracers"
+        q(:,:)=0 ! default, set everything to zero
+        qsurf(:)=0
+        ! "smarter" initialization of some tracers
+        ! (get values from "profile_*" files, if these are available)
+        do iq=1,nq
+          txt=""
+          write(txt,"(a)") tname(iq)
+          write(*,*)"  tracer:",trim(txt)
+          ! CO2
+          if (txt.eq."co2") then
+            q(:,iq)=0.95   ! kg /kg of atmosphere
+            qsurf(iq)=0. ! kg/m2 (not used for CO2)
+            ! even better, look for a "profile_co2" input file
+            open(91,file='profile_co2',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            endif
+            close(91)
+          endif ! of if (txt.eq."co2")
+          ! Allow for an initial profile of argon
+          ! Can also be used to introduce a decaying tracer
+          ! in the 1D (TBD) to study thermals
+          if (txt.eq."ar") then
+            !look for a "profile_ar" input file
+            open(91,file='profile_ar',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ar file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ar")
+
+          ! WATER VAPOUR
+          if (txt.eq."h2o_vap") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_vap',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_vap file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! WATER ICE
+          if (txt.eq."h2o_ice") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_ice',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_ice file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! DUST
+          !if (txt(1:4).eq."dust") then
+          !  q(:,iq)=0.4    ! kg/kg of atmosphere
+          !  qsurf(iq)=100 ! kg/m2
+          !endif
+          ! DUST MMR
+          if (txt.eq."dust_mass") then
+            !look for a "profile_dust_mass" input file
+            open(91,file='profile_dust_mass',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_mass file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_mass")
+          ! DUST NUMBER
+          if (txt.eq."dust_number") then
+            !look for a "profile_dust_number" input file
+            open(91,file='profile_dust_number',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_number file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_number")
+          ! NB: some more initializations (chemistry) is done later
+          ! CCN MASS
+          if (txt.eq."ccn_mass") then
+            !look for a "profile_ccn_mass" input file
+            open(91,file='profile_ccn_mass',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ccn_mass file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ccn_mass")
+          ! CCN NUMBER
+          if (txt.eq."ccn_number") then
+            !look for a "profile_ccn_number" input file
+            open(91,file='profile_ccn_number',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ccn_number file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ccn_number")
+        enddo ! of do iq=1,nq
+
+      else
+      ! we still need to set (dummy) tracer number and names for physdem1
+        nq=1
+        nqtot=nq ! set value of nqtot (in infotrac module) as nq
+        ! allocate arrays:
+        allocate(tname(nq))
+        allocate(q(nlayer,nq))
+        allocate(qsurf(nq))
+        allocate(dq(nlayer,nq))
+        allocate(dqdyn(nlayer,nq))
+        allocate(mqtot(nq))
+        do iq=1,nq
+          write(str7,'(a1,i2.2)')'t',iq
+          tname(iq)=str7
+        enddo
+      ! and just to be clean, also initialize tracers to zero for physdem1
+        q(:,:)=0 
+        qsurf(:)=0      
+      endif ! of if (tracer)
+      
+      !write(*,*) "testphys1d q", q(1,:)
+      !write(*,*) "testphys1d qsurf", qsurf
+
+c  Date and local time at beginning of run
+c  ---------------------------------------
+c    Date (in sols since spring solstice) at beginning of run
+      day0 = 0 ! default value for day0
+      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+      call getin("day0",day0)
+      day=float(day0)
+      write(*,*) " day0 = ",day0
+c  Local time at beginning of run 
+      time=0 ! default value for time
+      write(*,*)'Initial local time (in hours, between 0 and 24)?'
+      call getin("time",time)
+      write(*,*)" time = ",time
+      time=time/24.E+0 ! convert time (hours) to fraction of sol
+
+c  Discretization (Definition of grid and time steps)
+c  --------------
+c
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+
+      day_step=48 ! default value for day_step
+      PRINT *,'Number of time steps per sol ?'
+      call getin("day_step",day_step)
+      write(*,*) " day_step = ",day_step
+
+      ndt=10 ! default value for ndt
+      PRINT *,'Number of sols to run ?'
+      call getin("ndt",ndt)
+      write(*,*) " ndt = ",ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+
+c Imposed surface pressure
+c ------------------------------------
+c
+      psurf=610. ! default value for psurf
+      PRINT *,'Surface pressure (Pa) ?'
+      call getin("psurf",psurf)
+      write(*,*) " psurf = ",psurf
+c Reference pressures
+      pa=20.   ! transition pressure (for hybrid coord.)
+      preff=610.      ! reference surface pressure
+ 
+c Aerosol properties
+c --------------------------------
+      tauvis=0.2 ! default value for tauvis (dust opacity)
+      write(*,'("Reference dust opacity at ",f4.0," Pa ?")')odpref
+      call getin("tauvis",tauvis)
+      write(*,*) " tauvis = ",tauvis
+
+c Orbital parameters
+c ------------------
+      print *,'Min. distance Sun-Mars (Mkm)?'
+      call getin("periheli",periheli)
+      write(*,*) " periheli = ",periheli
+
+      print *,'Max. distance Sun-Mars (Mkm)?'
+      call getin("aphelie",aphelie)
+      write(*,*) " aphelie = ",aphelie
+
+      print *,'Day of perihelion?'
+      call getin("periday",peri_day)
+      write(*,*) " periday = ",peri_day
+
+      print *,'Obliquity?'
+      call getin("obliquit",obliquit)
+      write(*,*) " obliquit = ",obliquit
+ 
+c  latitude/longitude
+c  ------------------
+      latitude(1)=0 ! default value for latitude
+      PRINT *,'latitude (in degrees) ?'
+      call getin("latitude",latitude(1))
+      write(*,*) " latitude = ",latitude
+      latitude=latitude*pi/180.E+0
+      longitude=0.E+0
+      longitude=longitude*pi/180.E+0
+
+!  some initializations (some of which have already been
+!  done above!) and loads parameters set in callphys.def
+!  and allocates some arrays 
+!Mars possible matter with dtphys in input and include!!!
+      call phys_state_var_init(1,llm,nq,
+     .          daysec,dtphys,rad,g,r,cpp)
+      call ini_fillgeom(1,latitude,longitude,(/1.0/))
+      call conf_phys(1,llm,nq)
+
+
+c  Initialize albedo / soil thermal inertia
+c  ----------------------------------------
+c
+      albedodat(1)=0.2 ! default value for albedodat
+      PRINT *,'Albedo of bare ground ?'
+      call getin("albedo",albedodat(1))
+      write(*,*) " albedo = ",albedodat(1)
+
+      inertiedat(1,1)=400 ! default value for inertiedat
+      PRINT *,'Soil thermal inertia (SI) ?'
+      call getin("inertia",inertiedat(1,1))
+      write(*,*) " inertia = ",inertiedat(1,1)
+
+      z0(1)=z0_default ! default value for roughness
+      write(*,*) 'Surface roughness length z0 (m)?'
+      call getin("z0",z0(1))
+      write(*,*) " z0 = ",z0(1)
+
+! Initialize local slope parameters (only matters if "callslope"
+! is .true. in callphys.def)
+      ! slope inclination angle (deg) 0: horizontal, 90: vertical
+      theta_sl(1)=0.0 ! default: no inclination
+      call getin("slope_inclination",theta_sl(1))
+      ! slope orientation (deg)
+      ! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward
+      psi_sl(1)=0.0 ! default value
+      call getin("slope_orientation",psi_sl(1))
+      
+c
+c  for the gravity wave scheme
+c  ---------------------------------
+c
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+
+c   Specific initializations for "physiq"
+c   -------------------------------------
+c   mesh surface (not a very usefull quantity in 1D)
+      area(1)=1.E+0
+
+c   surface geopotential is not used (or useful) since in 1D
+c   everything is controled by surface pressure
+      phisfi(1)=0.E+0
+
+c   Initialization to take into account prescribed winds
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+c    geostrophic wind
+      gru=10. ! default value for gru
+      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
+      call getin("u",gru)
+      write(*,*) " u = ",gru
+      grv=0. !default value for grv
+      PRINT *,'meridional northward component of the geostrophic',
+     &' wind (m/s) ?'
+      call getin("v",grv)
+      write(*,*) " v = ",grv
+
+c     Initialize winds  for first time step
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     Initialize turbulente kinetic energy
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  CO2 ice on the surface
+c  -------------------
+      co2ice(1)=0.E+0 ! default value for co2ice
+      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
+      call getin("co2ice",co2ice)
+      write(*,*) " co2ice = ",co2ice
+
+c
+c  emissivity
+c  ----------
+      emis=emissiv
+      IF (co2ice(1).eq.1.E+0) THEN
+         emis=emisice(1) ! northern hemisphere
+         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
+      ENDIF
+
+ 
+
+c  Compute pressures and altitudes of atmospheric levels 
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      hybrid=.true.
+      PRINT *,'Hybrid coordinates ?'
+      call getin("hybrid",hybrid)
+      write(*,*) " hybrid = ", hybrid
+
+      CALL  disvert
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
+     &   /g
+      ENDDO
+
+
+c  Initialize temperature profile
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude in km in profile: divide zlay by 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+
+      call profile(nlayer+1,tmp1,tmp2)
+
+      tsurf=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      
+
+
+! Initialize soil properties and temperature
+! ------------------------------------------
+      volcapa=1.e6 ! volumetric heat capacity
+      DO isoil=1,nsoil
+         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+         tsoil(isoil)=tsurf(1)  ! soil temperature
+      ENDDO
+
+! Initialize depths
+! -----------------
+      do isoil=0,nsoil-1
+        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
+      enddo
+      do isoil=1,nsoil
+        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
+      enddo
+
+c    Initialize traceurs
+c    ---------------------------
+
+      if (photochem.or.callthermos) then
+         write(*,*) 'Initializing chemical species'
+         ! thermo=0: initialize over all atmospheric layers
+         thermo=0
+         call inichim_newstart(q,psurf,sig,nq,lati,long,area,
+     $   thermo,qsurf)
+      endif
+
+c Check if the surface is a water ice reservoir 
+c --------------------------------------------------
+      watercaptag(1)=.false. ! Default: no water ice reservoir
+      print *,'Water ice cap on ground ?'
+      call getin("watercaptag",watercaptag)
+      write(*,*) " watercaptag = ",watercaptag
+      
+
+c    Initialization for GRADS outputs in "g1d.dat" and "g1d.ctl"
+c    ----------------------------------------------------------------
+c    (output done in "writeg1d", typically called by "physiq.F")
+
+        g1d_nlayer=nlayer
+        g1d_nomfich='g1d.dat'
+        g1d_unitfich=40
+        g1d_nomctl='g1d.ctl'
+        g1d_unitctl=41
+        g1d_premier=.true.
+        g2d_premier=.true.
+
+c  Write a "startfi" file
+c  --------------------
+c  This file will be read during the first call to "physiq".
+c  It is needed to transfert physics variables to "physiq"...
+
+      call physdem0("startfi.nc",long,lati,nsoilmx,ngrid,llm,nq,
+     .              dtphys,float(day0),time,area,
+     .              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("startfi.nc",nsoilmx,ngrid,llm,nq,
+     .              dtphys,time,
+     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
+
+c=======================================================================
+c  1D MODEL TIME STEPPING LOOP
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+c        IF (idt.eq.ndt) lastcall=.true.
+        IF (idt.eq.ndt-day_step-1) then       !test
+         lastcall=.true.
+         call solarlong(day*1.0,zls)
+         write(103,*) 'Ls=',zls*180./pi
+         write(103,*) 'Lat=', lati(1)*180./pi
+         write(103,*) 'Tau=', tauvis/odpref*psurf
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(104,*) 'Ls=',zls*180./pi
+         write(104,*) 'Lat=', lati(1)
+         write(104,*) 'Tau=', tauvis/odpref*psurf
+         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c     compute geopotential
+c     ~~~~~~~~~~~~~~~~~~~~~
+      DO ilayer=1,nlayer
+        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       call physics
+c       --------------------
+!      write(*,*) "testphys1d avant q", q(1,:)
+      CALL physiq (1,llm,nq,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - outputs
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+!      write(*,*) "testphys1d apres q", q(1,:)
+
+
+c       wind increment : specific for 1D
+c       --------------------------------
+ 
+c       The physics compute the tendencies on u and v,
+c       here we just add Coriolos effect
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       For some tests : No coriolis force at equator
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Compute time for next time step
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       compute winds and temperature for next time step
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       compute pressure for next time step 
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! surface pressure change
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+!       increment tracers
+        DO iq = 1, nq
+          DO ilayer=1,nlayer
+             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+          ENDDO
+        ENDDO
+
+      ENDDO   ! of idt=1,ndt ! end of time stepping loop
+
+c    ========================================================
+c    OUTPUTS
+c    ========================================================
+
+c    finalize and close grads files "g1d.dat" and "g1d.ctl"
+
+c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
+        CALL endg1d(1,nlayer,zlay/1000.,ndt)
+
+      write(*,*) "testphys1d: Everything is cool."
+
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+c     Dummy subroutines used only in 3D, but required to
+c     compile testphys1d (to cleanly use writediagfi)
+
+      subroutine gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+
+      IMPLICIT NONE
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+      
+      if (ngrid.ne.1) then
+        write(*,*) "gr_fi_dyn error: in 1D ngrid should be 1!!!"
+        stop
+      endif
+      
+      pdyn(1,1,1:nfield)=pfi(1,1:nfield)
+      
+      end
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d/disvert.F"
+#include "../dyn3d/abort_gcm.F"
Index: unk/LMDZ.MARS/libf/phymars/ini_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/ini_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,523 +1,0 @@
-c=======================================================================
-      subroutine ini_archive(nid,idayref,phis,ith,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	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
-c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
-c	 du RUN + ptotal et cotoicetotal)
-c
-c			tab_cntrl(50+l)=tab_cntrl_fi(l)
-c
-c   Arguments:
-c   ---------
-c
-c	Inputs:
-c   ------
-c
-c       nid            unite logique du fichier "start_archive"
-c       idayref        Valeur du jour initial a mettre dans
-c                      l'entete du fichier "start_archive"
-c       phis           geopotentiel au sol
-c       ith            soil thermal inertia
-c       tab_cntrl_fi   tableau des param physiques
-c
-
-c=======================================================================
- 
-      use comsoil_h, only: nsoilmx, mlayer
-      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(length) ! tableau des parametres du run
-      INTEGER	loop
-      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
-      INTEGER	setdim
-      INTEGER	ind1,indlast
-
-c   Arguments:
-c   ----------
-      INTEGER*4	idayref
-      REAL		phis(ip1jmp1)
-      real ith(ip1jmp1,nsoilmx)
-      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 idim_nsoilmx ! "subsurface_layers" dimension ID #
-      INTEGER nid,nvarid
-      real sig_s(llm),s(llm)
-
-      pi  = 2. * ASIN(1.)
-
-
-c-----------------------------------------------------------------------
-c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
-c-----------------------------------------------------------------------
-
-      DO l=1,length
-         tab_cntrl(l)=0.
-      ENDDO
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      tab_cntrl(1)  = REAL(iim) ! nombre de points en longitude
-      tab_cntrl(2)  = REAL(jjm) ! nombre de points en latitude
-      tab_cntrl(3)  = REAL(llm) ! nombre de couches
-      tab_cntrl(4)  = REAL(idayref) ! jour 0
-      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
-      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
-      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
-      tab_cntrl(8)  = cpp 
-      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
-      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
-      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
-      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
-      tab_cntrl(12) = etot0 ! energie totale    !
-      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
-      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
-      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
-      tab_cntrl(16) = ang0 ! moment cinetique  !
-      tab_cntrl(17) = pa
-      tab_cntrl(18) = preff
-
-c    .....    parametres  pour le zoom      ......   
-
-      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
-      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
-      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
-      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
-
-      IF ( fxyhypb )   THEN
-       tab_cntrl(23) = 1.
-       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-      ELSE
-       tab_cntrl(23) = 0.
-       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-       tab_cntrl(26) = 0.
-       IF ( ysinus)  tab_cntrl(26) = 1.
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   Copie du tableau des parametres de controle du RUN  (physique)
-c		dans le tableau dynamique
-c-----------------------------------------------------------------------
-
-      DO l=1,50
-         tab_cntrl(50+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", 21,
-     &                       "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, "latitude", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
-      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
-
-      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
-      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid,"interlayer", 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-----------------------------------------------------------------------
-
-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,"aps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
-     .      "Coef AS: hybrid pressure in midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
-#endif
-c
-c ----------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
-     .      "Coef BS: hybrid sigma midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
-#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  Variable uniquement pour visualisation avec Grads ou Ferret
-c ------------------------------------------------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "North latitude")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
-#endif
-c----------------------
-       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "East longitude")
-      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
-#endif
-c--------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
-     .       idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
-     .       idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
-
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
-#endif
-
-!-------------------------------
-! (soil) depth variable mlayer() (known from comsoil.h)
-!-------------------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     .                        "Soil mid-layer depth")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
-#endif
-
-!---------------------
-! soil thermal inertia
-!---------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      dims3(1)=idim_rlonv
-      dims3(2)=idim_rlatu
-      dims3(3)=idim_nsoilmx
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     &                        "Soil thermal inertia")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
-     &                        "J.s-1/2.m-2.K-1")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
-#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
-
-      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
-      PRINT*,'rad,omeg,g,mugaz,kappa',
-     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
-      PRINT*,'daysec,dtvr',daysec,dtvr
-
-      RETURN
-      END
Index: unk/LMDZ.MARS/libf/phymars/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90	(revision 1402)
+++ 	(revision )
@@ -1,142 +1,0 @@
-subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
-                     rlatu,rlonv,aire,cu,cv,                             &
-                     prad,pg,pr,pcpp,iflag_phys)
-
-use dimphy, only : klev ! number of atmospheric levels
-use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
-                                       ! (on full grid)
-use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
-                               klon_omp_begin, & ! start index of local omp subgrid
-                               klon_omp_end, & ! end index of local omp subgrid
-                               klon_mpi_begin ! start indes of columns (on local mpi grid)
-
-use comgeomphy, only : initcomgeomphy, &
-                       airephy, & ! physics grid area (m2)
-                       cuphy, & ! cu coeff. (u_covariant = cu * u)
-                       cvphy, & ! cv coeff. (v_covariant = cv * v)
-                       rlond, & ! longitudes
-                       rlatd ! latitudes
-use infotrac, only : nqtot ! number of advected tracers
-use comgeomfi_h, only: ini_fillgeom
-
-implicit none
-
-include "iniprint.h"
-
-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 (full grid)
-integer,intent(in) :: nlayer ! number of atmospheric layers
-integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
-integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
-real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
-real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
-real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
-real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
-real,intent(in) :: cv((ii+1)*jj) ! 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 :: ibegin,iend,offset
-integer :: i,j
-character(len=20) :: modname='iniphysiq'
-character(len=80) :: abort_message
-real :: total_area_phy, total_area_dyn
-
-
-! global array, on full physics grid:
-real,allocatable :: latfi(:)
-real,allocatable :: lonfi(:)
-real,allocatable :: cufi(:)
-real,allocatable :: cvfi(:)
-real,allocatable :: airefi(:)
-
-IF (nlayer.NE.klev) THEN
-  write(*,*) 'STOP in ',trim(modname)
-  write(*,*) 'Problem with dimensions :'
-  write(*,*) 'nlayer     = ',nlayer
-  write(*,*) 'klev   = ',klev
-  abort_message = ''
-  CALL abort_gcm (modname,abort_message,1)
-ENDIF
-
-!IF (ngrid.NE.klon_glo) THEN
-!  write(*,*) 'STOP in ',trim(modname)
-!  write(*,*) 'Problem with dimensions :'
-!  write(*,*) 'ngrid     = ',ngrid
-!  write(*,*) 'klon   = ',klon_glo
-!  abort_message = ''
-!  CALL abort_gcm (modname,abort_message,1)
-!ENDIF
-
-! Generate global arrays on full physics grid
-allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
-latfi(1)=rlatu(1)
-lonfi(1)=0.
-cufi(1) = cu(1)
-cvfi(1) = cv(1)
-DO j=2,jj
-  DO i=1,ii
-    latfi((j-2)*ii+1+i)= rlatu(j)
-    lonfi((j-2)*ii+1+i)= rlonv(i)
-    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
-    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
-  ENDDO
-ENDDO
-latfi(klon_glo)= rlatu(jj+1)
-lonfi(klon_glo)= 0.
-cufi(klon_glo) = cu((ii+1)*jj+1)
-cvfi(klon_glo) = cv((ii+1)*jj-ii)
-
-! build airefi(), mesh area on physics grid
-allocate(airefi(klon_glo))
-CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
-! Poles are single points on physics grid
-airefi(1)=sum(aire(1:ii,1))
-airefi(klon_glo)=sum(aire(1:ii,jj+1))
-
-! Sanity check: do total planet area match between physics and dynamics?
-total_area_dyn=sum(aire(1:ii,1:jj+1))
-total_area_phy=sum(airefi(1:klon_glo))
-IF (total_area_dyn/=total_area_phy) THEN
-  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
-  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
-  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
-  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
-    ! stop here if the relative difference is more than 0.001%
-    abort_message = 'planet total surface discrepancy'
-    CALL abort_gcm(modname, abort_message, 1)
-  ENDIF
-ENDIF
-
-
-
-!$OMP PARALLEL 
-! Now generate local lon/lat/cu/cv/area arrays
-call initcomgeomphy
-
-!!!!$OMP PARALLEL PRIVATE(ibegin,iend) 
-!!!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
-      
-offset=klon_mpi_begin-1
-airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
-cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
-cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
-
-! copy some fundamental parameters to physics 
-! and do some initializations 
-call phys_state_var_init(klon_omp,nlayer,nqtot, &
-                         punjours,ptimestep,prad,pg,pr,pcpp)
-call ini_fillgeom(klon_omp,rlatd,rlond,airephy)
-call conf_phys(klon_omp,nlayer,nqtot)
-
-!$OMP END PARALLEL
-
-
-end subroutine iniphysiq
Index: unk/LMDZ.MARS/libf/phymars/lect_start_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/lect_start_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,1432 +1,0 @@
-      SUBROUTINE lect_start_archive(ngrid,nlayer,nqtot,
-     &     date,tsurf,tsoil,emis,q2,
-     &     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,
-     &     q,qsurf,tauscaling,surfith,nid)
-c=======================================================================
-c
-c
-c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
-c   ------
-c
-c
-c   Objet:     Lecture des variables d'un fichier "start_archive"
-c              Plus besoin de régler ancienne valeurs grace
-c              a l'allocation dynamique de memoire (Yann Wanherdrick)
-c
-c
-c
-c=======================================================================
-      use infotrac, only: tname
-      use comsoil_h, only: nsoilmx, layer, mlayer, volcapa, inertiedat
-      use planete_h
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "description.h"
-#include "ener.h"
-#include "temps.h"
-#include "netcdf.inc"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-! routine arguments
-! -----------------
-      integer,intent(in) :: ngrid ! number of atmosphferic columns
-                                  ! on new physics grid
-      integer,intent(in) :: nlayer ! number of atmospheric layers
-                                   ! on new grid
-      integer,intent(in) :: nqtot ! number of advected tracers
-      REAL,INTENT(OUT) :: date
-      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
-      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
-      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
-      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
-      REAL,INTENT(OUT) :: co2ice(ngrid) ! CO2 ice layer
-      REAL,INTENT(OUT) :: emis(ngrid)
-      REAL,INTENT(OUT) :: q2(ngrid,nlayer+1),qsurf(ngrid,nqtot)
-      REAL,INTENT(OUT) :: tauscaling(ngrid) ! dust conversion factor
-      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
-      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
-      real,intent(in) :: surfith(iip1,jjp1) ! surface thermal inertia
-      INTEGER,INTENT(IN) :: nid ! input NetCDF file identifier
-
-
-
-c Old variables dimensions (from file)
-c------------------------------------
-      INTEGER   imold,jmold,lmold,nsoilold,nqold
-
-c Variables pour les lectures des fichiers "ini" 
-c--------------------------------------------------
-!      INTEGER sizei,
-      integer timelen,dimid
-!      INTEGER length
-!      parameter (length = 100)
-      INTEGER tab0
-      INTEGER isoil,iq,iqmax
-      CHARACTER*2   str2
-
-!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
-
-!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
-
-!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
-!      CHARACTER*120 dimsource
-!      CHARACTER*16 dimname
-!      CHARACTER*80 dimtitle
-!      CHARACTER*40 dimunits
-!      INTEGER   dimtype
-
-!      INTEGER dimord(4)  ! tableau contenant l''ordre
-!      data dimord /1,2,3,4/ ! de sortie des dimensions
-
-!      INTEGER vardim(4)
-      INTEGER   memo
-!      character (len=50) :: tmpname
-
-c Variable histoire 
-c------------------
-      REAL ::qtot(iip1,jjp1,llm)
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-
-c!-*-
-!      integer klatdat,klongdat
-!      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-
-c variable physique
-c------------------
-c     REAL phisfi(ngrid)
-
-      INTEGER i,j,l
-      INTEGER nvarid
-c     REAL year_day,periheli,aphelie,peri_day
-c     REAL obliquit,z0,emin_turb,lmixmin
-c     REAL emissiv,emisice(2),albedice(2),tauvis
-c     REAL iceradius(2) , dtemisice(2)
-
-!      EXTERNAL RAN1
-!      REAL RAN1
-!      EXTERNAL geopot,inigeom
-      integer ierr
-!      integer ismin
-!      external ismin
-!      CHARACTER*80 datapath
-      integer, dimension(4) :: start,count
-
-c Variable nouvelle grille naturelle au point scalaire
-c------------------------------------------------------
-      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
-      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
-      real inertiedatS(iip1,jjp1,nsoilmx)
-      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
-      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
-      real tauscalingS(iip1,jjp1)
-
-      real ptotal, co2icetotal
-
-c Var intermediaires : vent naturel, mais pas coord scalaire
-c-----------------------------------------------------------
-      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
-
-
-c Variable de l'ancienne grille 
-c---------------------------------------------------------
-
-      real, dimension(:), allocatable :: timelist
-      real, dimension(:), allocatable :: rlonuold, rlatvold
-      real, dimension(:), allocatable :: rlonvold, rlatuold
-      real, dimension(:), allocatable :: apsold,bpsold
-      real, dimension(:), allocatable :: mlayerold
-      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
-      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
-      real, dimension(:,:,:),allocatable :: tsoiloldnew
-! tsoiloldnew: old soil values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatold
-! inertiedatoldnew: old inertia values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatoldnew
-      real, dimension(:,:), allocatable :: psold,phisold
-      real, dimension(:,:), allocatable :: co2iceold,tsurfold
-      real, dimension(:,:), allocatable :: emisold
-      real, dimension(:,:,:,:), allocatable :: qold
-      real, dimension(:,:), allocatable :: tauscalingold
-
-      real tab_cntrl(100)
-
-      real ptotalold, co2icetotalold
-
-      logical :: olddepthdef=.false. ! flag
-! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
-      logical :: depthinterpol=.false. ! flag
-! depthinterpol=.true. if interpolation will be requiered
-      logical :: therminertia_3D=.true. ! flag
-! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
-c Variable intermediaires iutilise pour l'extrapolation verticale 
-c----------------------------------------------------------------
-      real, dimension(:,:,:), allocatable :: var,varp1 
-      real, dimension(:), allocatable :: oldgrid, oldval
-      real, dimension(:), allocatable :: newval
-!      real, dimension(:), allocatable :: oldmlayer
-
-!      real surfithfi(ngrid)
-      ! surface thermal inertia at old horizontal grid resolution
-      real, dimension(:,:), allocatable :: surfithold 
-
-! flag which identifies if archive file is using old tracer names (qsurf01,...)
-      logical :: oldtracernames=.false.
-      integer :: counter
-      character(len=30) :: txt ! to store some text
-      real :: tmpval ! to store a temporary variable/value
-
-c=======================================================================
-
-! 0. Preliminary stuff
-
-! check if tracers follow old naming convention (q01, q02, q03, ...)
-      counter=0
-      do iq=1,nqtot
-        txt= " "
-        write(txt,'(a1,i2.2)')'q',iq
-        ierr=NF_INQ_VARID(nid,txt,nvarid)
-        if (ierr.ne.NF_NOERR) then
-          ! did not find old tracer name
-          exit ! might as well stop here
-        else
-          ! found old tracer name
-          counter=counter+1
-        endif
-      enddo
-      if (counter.eq.nqtot) then
-        write(*,*) "lect_start_archive: tracers seem to follow old ",
-     &             "naming convention (q01, q02,...)"
-        oldtracernames=.true.
-      endif
-
-
-!-----------------------------------------------------------------------
-! 1. Read data dimensions (i.e. size and length)
-!-----------------------------------------------------------------------
-
-! 1.2 Read the various dimension lengths of data in file 
-
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"temps",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find Time length'
-        stop
-      else
-        write(*,*) "lect_start_archive: timelen=",timelen
-      endif
-
-      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find lat length'
-        stop
-      else
-        write(*,*) "lect_start_archive: jmold=",jmold
-      endif
-      jmold=jmold-1
-
-      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find lon length'
-        stop
-      else
-        write(*,*) "lect_start_archive: imold=",imold
-      endif
-      imold=imold-1
-
-      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find alt length'
-        stop
-      else
-        write(*,*) "lect_start_archive: lmold=",lmold
-      endif
-
-      nqold=0
-      do
-         write(str2,'(i2.2)') nqold+1
-         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
-!        write(*,*) 'q'//str2
-         if (ierr.eq.NF_NOERR) then
-            nqold=nqold+1
-         else
-            exit
-         endif
-      enddo
-
-! 1.2.1 find out the # of subsurface_layers
-      nsoilold=0 !dummy initialisation
-      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
-      if (ierr.eq.NF_NOERR) then
-        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
-	if (ierr.ne.NF_NOERR) then
-	 write(*,*)'lec_start_archive: ',
-     &              'Failed reading subsurface_layers length'
-	endif
-      else
-        write(*,*)"lec_start_archive: did not find subsurface_layers"
-      endif
-
-      if (nsoilold.eq.0) then ! 'old' archive format;
-      ! must use Tg//str2 fields to compute nsoilold
-      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
-        do
-	 write(str2,'(i2.2)') nsoilold+1
-	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
-	 if (ierr.eq.NF_NOERR) then
-	  nsoilold=nsoilold+1
-	 else
-	  exit
-	 endif
-	enddo
-      endif
-
-
-      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
-        depthinterpol=.true.
-      endif
-
-! 1.3 Report dimensions
-      
-      write(*,*) "lect_start_archive: Start_archive dimensions:"
-      write(*,*) "longitude: ",imold
-      write(*,*) "latitude: ",jmold
-      write(*,*) "altitude: ",lmold
-      if (nqold.gt.0) then
-        write(*,*) "old tracers q*: ",nqold
-      endif
-      write(*,*) "subsurface_layers: ",nsoilold
-      if (depthinterpol) then
-      write(*,*) " => Warning, nsoilmx= ",nsoilmx
-      write(*,*) '    which implies that you want subterranean interpola
-     &tion.'
-      write(*,*) '  Otherwise, set nsoilmx -in comsoil_h- to: ',nsoilold
-      endif
-      write(*,*) "time lenght: ",timelen
-      write(*,*) 
-
-!-----------------------------------------------------------------------
-! 2. Allocate arrays to store datasets
-!-----------------------------------------------------------------------
-
-      allocate(timelist(timelen))
-      allocate(rlonuold(imold+1), rlatvold(jmold))
-      allocate(rlonvold(imold+1), rlatuold(jmold+1))
-      allocate (apsold(lmold),bpsold(lmold))
-      allocate(uold(imold+1,jmold+1,lmold))
-      allocate(vold(imold+1,jmold+1,lmold))
-      allocate(told(imold+1,jmold+1,lmold))
-      allocate(psold(imold+1,jmold+1))
-      allocate(phisold(imold+1,jmold+1))
-      allocate(qold(imold+1,jmold+1,lmold,nqtot))
-      allocate(co2iceold(imold+1,jmold+1))
-      allocate(tsurfold(imold+1,jmold+1))
-      allocate(emisold(imold+1,jmold+1))
-      allocate(q2old(imold+1,jmold+1,lmold+1))
-!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
-      allocate(tsoilold(imold+1,jmold+1,nsoilold))
-      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
-      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
-      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
-      ! surface thermal inertia at old horizontal grid resolution
-      allocate(surfithold(imold+1,jmold+1))
-      allocate(mlayerold(nsoilold))
-      allocate(qsurfold(imold+1,jmold+1,nqtot))
-      allocate(tauscalingold(imold+1,jmold+1))
-
-      allocate(var (imold+1,jmold+1,llm))
-      allocate(varp1 (imold+1,jmold+1,llm+1))
-
-      write(*,*) 'q2',ngrid,nlayer+1
-      write(*,*) 'q2S',iip1,jjp1,llm+1
-      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
-
-!-----------------------------------------------------------------------
-! 3. Read time-independent data
-!-----------------------------------------------------------------------
-
-C-----------------------------------------------------------------------
-c 3.1. Lecture du tableau des parametres du run 
-c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Lect_start_archive: <controle> is missing"
-         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*, "lect_start_archive: Failed loading <controle>"
-         CALL abort
-      ENDIF
-c
-      tab0 = 50
-
-c-----------------------------------------------------------------------
-c 3.2 Lecture des longitudes et latitudes
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlonv> is missing"
-         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*, "lect_start_archive: Failed loading <rlonv>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlatu> is missing"
-         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*, "lect_start_archive: Failed loading <rlatu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlonu> is missing"
-         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*, "lect_start_archive: Failed loading <rlonu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlatv> is missing"
-         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*, "lect_start_archive: Failed loading <rlatv>"
-         CALL abort
-      ENDIF
-c
-
-c-----------------------------------------------------------------------
-c 3.3. Lecture des niveaux verticaux
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "aps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <aps> is missing"
-         apsold=0
-         PRINT*, "<aps> set to 0"
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: Failed loading <aps>"
-         ENDIF
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "bps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <bps> is missing"
-         PRINT*, "It must be an old start_archive, lets look for sig_s"
-         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "Nothing to do..."
-            CALL abort
-         ENDIF
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <bps>"
-         CALL abort
-      END IF
-
-c-----------------------------------------------------------------------
-c 3.4 Read Soil layers depths
-c-----------------------------------------------------------------------
-     
-      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <soildepth>'
-       write(*,*)' => Assuming this is an archive in old format'
-       olddepthdef=.true.
-       depthinterpol=.true.
-       ! this is how soil depth was defined in ye old days
-	do isoil=1,nsoilold
-	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
-	enddo
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-
-      endif !of if(ierr.ne.NF_NOERR)
-
-      ! Read (or build) mlayer()
-      if (depthinterpol) then
-       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
-       ! as in soil_settings.F
-       write(*,*)' => Building default soil depths'
-       do isoil=0,nsoilmx-1
-         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
-       enddo
-       write(*,*)' => mlayer: ',mlayer
-       ! Also build (default) new soil interlayer depth layer(:)
-       do isoil=1,nsoilmx
-         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
-     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
-       enddo
-       write(*,*)' =>  layer: ',layer
-      else ! read mlayer() from file
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-       ! Also build (default) soil interlayer depth layer(:)
-       do isoil=1,nsoilmx
-         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
-     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
-       enddo
-      endif ! of if (depthinterpol)
-
-c-----------------------------------------------------------------------
-c 3.5 Read Soil thermal inertia
-c-----------------------------------------------------------------------
-
-      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <inertiedat>'
-       write(*,*)' => Assuming this is an archive in old format'
-       therminertia_3D=.false.
-       write(*,*)' => Thermal inertia will be read from reference file'
-       volcapa=1.e6
-       write(*,*)'    and soil volumetric heat capacity is set to ',
-     &           volcapa
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
-         CALL abort
-       endif
-      endif
-
-c-----------------------------------------------------------------------
-c 3.6 Lecture geopotentiel au sol
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <phisinit> is missing"
-         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*, "lect_start_archive: Failed loading <phisinit>"
-         CALL abort
-      ENDIF
-
-C-----------------------------------------------------------------------
-c   lecture de "ptotalold" et "co2icetotalold"
-c-----------------------------------------------------------------------
-      ptotalold = tab_cntrl(tab0+49)
-      co2icetotalold = tab_cntrl(tab0+50)
- 
-c-----------------------------------------------------------------------
-c 4. Lecture du temps et choix
-c-----------------------------------------------------------------------
- 
-c  lecture du temps
-c
-      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: <Time> is missing"
-            CALL abort
-         endif
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_VARID (nid, "temps", nvarid)
-      endif 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <Time>"
-         CALL abort
-      ENDIF
-c
-      write(*,*)
-      write(*,*)
-      write(*,*) 'Dates of the stored initial states:'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      pi=2.*ASIN(1.)
-      do i=1,timelen
-c       call solarlong(timelist(i),sollong(i))
-c       sollong(i) = sollong(i)*180./pi
-c        write(*,*) 'initial state at martian day: ',int(timelist(i))
-        write(*,*) 'initial state at martian day: ',timelist(i)
-c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
-c    .    sollong(i)
-      end do
-
-   6  FORMAT(i7,i7,f9.3)
- 
-      write(*,*)
-      write(*,*) 'Choose the martian day to use'
- 123  read(*,*,iostat=ierr) date
-      if(ierr.ne.0) goto 123
-      memo = 0
-      do i=1,timelen
-c        if (date.eq.int(timelist(i))) then
-        if (abs(date-timelist(i)).lt.0.01) then
-            memo = i
-        endif
-      end do
- 
-      if (memo.eq.0) then
-        write(*,*)
-        write(*,*)
-        write(*,*) 'Wrong value for day number !!'
-        write(*,*)
-        write(*,*) 'Dates of the stored initial states:'
-        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-        do i=1,timelen
-          write(*,*) 'initial state at martian day: ',timelist(i)
-c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
-        end do
-        goto 123
-      endif
-      
-!-----------------------------------------------------------------------
-! 5. Read (time-dependent) data from datafile
-!-----------------------------------------------------------------------
-
-
-c-----------------------------------------------------------------------
-c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf, tauscaling)
-c-----------------------------------------------------------------------
- 
-      start=(/1,1,memo,0/)
-      count=(/imold+1,jmold+1,1,0/)
-       
-      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <co2ice> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <co2ice>"
-         PRINT*, NF_STRERROR(ierr)
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "emis", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <emis> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <emis>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <ps> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <ps>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <tsurf> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <tsurf>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <q2surf> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <q2surf>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "tauscaling", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <tauscaling> not in file"
-         tauscalingold(:,:) = -1
-      ELSE
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tauscalingold)
-#else
-        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tauscalingold)
-#endif
-        IF (ierr .NE. NF_NOERR) THEN
-           PRINT*, "lect_start_archive: Failed loading <tauscaling>"
-           PRINT*, NF_STRERROR(ierr)
-           CALL abort
-        ENDIF
-      ENDIF
-c
-      write(*,*)"lect_start_archive: rlonuold:"
-     &           ,rlonuold," rlatvold:",rlatvold
-      write(*,*)
-c
-
-c tracers: the 2 last ones are kept the 2 last one. 
-c the others keep their rank. ! No longer true.
-c -------------------------------------------
-! Surface tracers:      
-      qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0
-
-      DO iq=1,nqtot
-        IF (oldtracernames) THEN
-          txt=" "
-          write(txt,'(a5,i2.2)')'qsurf',iq
-        ELSE
-          txt=trim(tname(iq))//"_surf"
-          if (txt.eq."h2o_vap") then
-            ! There is no surface tracer for h2o_vap;
-            ! "h2o_ice" should be loaded instead
-            txt="h2o_ice_surf"
-            write(*,*) 'lect_start_archive: loading surface tracer',
-     &                     ' h2o_ice instead of h2o_vap'
-          endif
-        ENDIF ! of IF (oldtracernames)
-        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-          print*, "which (constant) value should it be initialized to?"
-          read(*,*) tmpval
-          qsurfold(1:imold+1,1:jmold+1,iq)=tmpval
-        ELSE ! tracer exists in file, load it
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &             " Failed loading <",trim(txt),">"
-            stop
-          ENDIF
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-!-----------------------------------------------------------------------
-! 5.2 Read 3D subterranean fields
-!-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-!
-! Read soil temperatures
-!
-      if (olddepthdef) then ! tsoil stored using the 'old format'
-         start=(/1,1,memo,0/)
-         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
-       do isoil=1,nsoilold
-!        write(*,*)'isoil',isoil
-         write(str2,'(i2.2)') isoil
-c
-         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              "Field <","Tg"//str2,"> not found"
-            CALL abort
-         ENDIF
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#else
-         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &            "Failed reading <","Tg"//str2,">"
-            CALL abort
-         ENDIF
-c
-       enddo ! of do isoil=1,nsoilold
-      
-      ! reset 'start' and 'count' to "3D" behaviour
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-      
-      else
-       write(*,*) "lect_start_archive: loading tsoil "
-       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
-       if (ierr.ne.NF_NOERR) then
-        write(*,*)"lect_start_archive: Cannot find <tsoil>"
-	call abort
-       else
-#ifdef NC_DOUBLE
-      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
-#else
-      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
-#endif
-       endif ! of if (ierr.ne.NF_NOERR)
-       
-      endif ! of if (olddepthdef)
-
-!
-! Read soil thermal inertias
-!
-!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
-!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-!       if (ierr.ne.NF_NOERR) then
-!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
-!	call abort
-!       else
-!#ifdef NC_DOUBLE
-!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
-!#else
-!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
-!#endif
-!       endif ! of if (ierr.ne.NF_NOERR)
-!      endif
-
-c-----------------------------------------------------------------------
-c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
-c-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,lmold,1/)
-
-c
-      ierr = NF_INQ_VARID (nid,"temp", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <temp> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <temp>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"u", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <u> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <u>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"v", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <v> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <v>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <q2atm> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <q2atm>"
-         CALL abort
-      ENDIF
-c
-
-c tracers: the 2 last ones are kept the 2 last one. 
-c the others keep their rank. ! No longer true.
-c -------------------------------------------
-! Tracers:
-      qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0
-
-      DO iq=1,nqtot
-        IF (oldtracernames) THEN
-          txt=" "
-          write(txt,'(a1,i2.2)')'q',iq
-        ELSE
-          txt=tname(iq)
-        ENDIF
-        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-          print*, "which (constant) value should it be initialized to?"
-          read(*,*) tmpval
-          qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval
-        ELSE ! tracer exists in file, load it
-#ifdef NC_DOUBLE
-         ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
-#else
-         ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &             "  Failed loading <",trim(txt),">"
-            stop
-          ENDIF
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-
-c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
-c -------------------------------------------------------------------------
-
-!      datapath = '/users/forget/gcm/data_mars_gcm'
-
-
-!=======================================================================
-! 6. Interpolation from old grid to new grid
-!=======================================================================
-
-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 6.1	Variable 2d :
-c-----------------------------------------------------------------------
-c Relief 
-      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c Glace CO2
-      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c Temperature de surface
-      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,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,iim+1,jjm+1,ngrid,tsoils,tsoil)
-c     write(45,*) 'tsoil',tsoil
-
-c Emissivite de la surface
-      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
-
-c Dust conversion factor
-      call interp_horiz (tauscalingold,tauscalings,imold,jmold,iim,jjm,
-     &                   1,rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tauscalings,tauscaling)
-c     write(46,*) 'emis',emis
-c-----------------------------------------------------------------------
-c 6.1.2	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-----------------------------------------------------------------------
-c	On assure la conservation de la masse de l'atmosphere + calottes
-c-----------------------------------------------------------------------
-
-      ptotal =  0.
-      co2icetotal = 0.
-      DO j=1,jjp1
-         DO i=1,iim
-            ptotal=ptotal+ps(i,j)*aire(i,j)/g
-            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
-         END DO
-      END DO
-
-      write(*,*)
-      write(*,*)'Old grid: mass of the atmosphere :',ptotalold
-      write(*,*)'New grid: mass of the atmosphere :',ptotal
-      write (*,*) 'Ratio new atm / old atm =', ptotal/ptotalold 
-      write(*,*)
-      write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold
-      write(*,*)'New grid: mass of CO2 ice:',co2icetotal
-      if (co2icetotalold.ne.0.) then
-       write(*,*)'Ratio new ice / old ice =',co2icetotal/co2icetotalold
-      endif
-      write(*,*)
-
-
-      DO j=1,jjp1
-         DO i=1,iip1
-            ps(i,j)=ps(i,j) * ptotalold/ptotal
-         END DO
-      END DO
-
-      if ( co2icetotalold.gt.0.) then 
-         DO j=1,jjp1
-            DO i=1,iip1
-               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
-            END DO
-         END DO
-      end if
-
-c-----------------------------------------------------------------------
-c 6.2 Subterranean 3d variables:
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c 6.2.1 Thermal Inertia
-c       Note: recall that inertiedat is a common in "comsoil.h"
-c-----------------------------------------------------------------------
-
-      ! depth-wise interpolation, if required
-      if (depthinterpol.and.(.not.olddepthdef)) then
-        allocate(oldval(nsoilold))
-	allocate(newval(nsoilmx))
-        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
-     &f soil thermal inertia; might be wiser to reset it.'
-        write(*,*)
-       
-        do i=1,imold+1
-         do j=1,jmold+1
-	   !copy old values
-	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
-	   !interpolate
-	   call interp_line(mlayerold,oldval,nsoilold,
-     &                     mlayer,newval,nsoilmx)
-           !copy interpolated values
-           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-        enddo
-        ! cleanup
-	deallocate(oldval)
-	deallocate(newval)
-      endif !of if (depthinterpol)
-
-      if (therminertia_3D) then
-        ! We have inertiedatold
-       if((imold.ne.iim).or.(jmold.ne.jjm)) then
-       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
-     &of thermal inertia; might be better to reset it.'
-       write(*,*)
-       endif
-       
-        ! Do horizontal interpolation
-	if (depthinterpol) then
-	  call interp_horiz(inertiedatoldnew,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-	else
-          call interp_horiz(inertiedatold,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilold,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-        endif ! of if (depthinterpol)
-
-      else ! no 3D thermal inertia data
-       write(*,*)'lect_start_archive: using reference surface inertia'
-        ! Use surface inertia (and extend it to all depths)
-        do i=1,nsoilmx
-         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
-        enddo
-	! Build an old resolution surface thermal inertia
-	! (will be needed for tsoil interpolation)
-	call interp_horiz(surfith,surfithold,
-     &                    iim,jjm,imold,jmold,1,
-     &                    rlonu,rlatv,rlonuold,rlatvold)
-      endif
-
-
-      ! Reshape inertiedatS to scalar grid as inertiedat
-      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
-     &                  inertiedatS,inertiedat)
-      
-c-----------------------------------------------------------------------
-c 6.2.2 Soil temperature
-c-----------------------------------------------------------------------
-!      write(*,*) 'Soil'
-      ! Recast temperatures along soil depth, if necessary
-      if (olddepthdef) then
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        do i=1,imold+1
-	 do j=1,jmold+1
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	   ! build vertical coordinate
-	   oldgrid(1)=0. ! ground
-	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
-     &                (surfithold(i,j)/1.e6)
-          ! Note; at this stage, we impose volcapa=1.e6 above
-	  ! since volcapa isn't set in old soil definitions
-
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-
-      else
-       if (depthinterpol) then ! if vertical interpolation is required
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        ! build vertical coordinate
-	oldgrid(1)=0. ! ground
-	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
-        do i=1,imold+1
-	 do j=1,jmold+1
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-       
-       else
-        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
-       endif ! of if (depthinterpol)
-      endif ! of if (olddepthdef)
-
-      ! Do the horizontal interpolation
-       call interp_horiz(tsoiloldnew,tsoilS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-      ! Reshape tsoilS to scalar grid as tsoil
-       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
-
-
-
-c-----------------------------------------------------------------------
-c 6.3 Variable 3d :
-c-----------------------------------------------------------------------
-      
-c temperatures atmospheriques
-      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
-      call interp_vert
-     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
-     &     psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
-      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
-
-c q2 : pbl wind variance
-      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
-      call interp_vert (q2old,varp1,lmold+1,llm+1,
-     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
-      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
-      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
-      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
-c     write(47,*) 'q2',q2
-
-c calcul des champ de vent; passage en vent covariant
-      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
-      call interp_vert
-     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
-     &  psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
-      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
-
-      call interp_vert
-     & (vold,var,lmold,llm,
-     &  apsold,bpsold,aps,bps,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 (*,*) 'lect_start_archive: unat ', unat (1,1,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)
-c           ucov( i,j,l ) = 0
-          end do
-        end do
-      end do 
-      write (*,*) 'lect_start_archive: ucov ', ucov (1,1,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)
-c           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 traceurs surface
-      do iq = 1, nqtot
-            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
-     &                  imold,jmold,iim,jjm,1,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-
-      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
-
-c traceurs 3D
-      do  iq = 1, nqtot
-            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
-     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-cccccccccccccccccccccccccccccc      
-c  make sure that sum of q = 1      
-c dominent species is = 1 - sum(all other species)      
-cccccccccccccccccccccccccccccc      
-c      iqmax=1
-c      
-c      if (nqold.gt.10) then
-c       do l=1,llm
-c        do j=1,jjp1
-c          do i=1,iip1
-c           do iq=1,nqold
-c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
-c              iqmax=iq
-c            endif
-c           enddo
-c           q(i,j,l,iqmax)=1.
-c           qtot(i,j,l)=0
-c           do iq=1,nqold
-c            if (iq.ne.iqmax) then        
-c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
-c            endif
-c           enddo !iq
-c           do iq=1,nqold
-c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
-c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
-c     $    qtot(i,j,l)
-c           enddo !iq
-c          enddo !i   
-c         enddo !j   
-c       enddo !l  
-c      endif
-ccccccccccccccccccccccccccccccc
-
-c     Periodicite :
-      do  iq = 1, nqtot
-         do l=1, llm
-            do j = 1, jjp1
-               q(iip1,j,l,iq) = q(1,j,l,iq)
-            end do
-         end do
-      enddo
-      
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
-
-c-----------------------------------------------------------------------
-c   Initialisation  h:	(passage de t -> h)
-c-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO j=1,jjp1
-            DO i=1,iim
-               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
-            END DO
-            h(iip1,j,l) =  h(1,j,l)
-         END DO
-      END DO
-
-
-c***********************************************************************
-c***********************************************************************
-c     Fin subroutine lecture ini
-c***********************************************************************
-c***********************************************************************
-
-      deallocate(timelist)
-      deallocate(rlonuold, rlatvold)
-      deallocate(rlonvold, rlatuold)
-      deallocate(apsold,bpsold)
-      deallocate(uold)
-      deallocate(vold)
-      deallocate(told)
-      deallocate(psold)
-      deallocate(phisold)
-      deallocate(qold)
-      deallocate(co2iceold)
-      deallocate(tsurfold)
-      deallocate(emisold)
-      deallocate(q2old)
-      deallocate(tsoilold)
-      deallocate(tsoiloldnew)
-      deallocate(inertiedatold)
-      deallocate(inertiedatoldnew)
-      deallocate(surfithold)
-      deallocate(mlayerold)
-      deallocate(qsurfold)
-      deallocate(tauscalingold)
-      deallocate(var,varp1)
-
-!      write(*,*)'lect_start_archive: END'
-      return
-      end
Index: unk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90	(revision 1402)
+++ 	(revision )
@@ -1,453 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_grid_phy_lmdz
-
-  PUBLIC
-  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
-             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
-
-  INTEGER,SAVE :: nbp_lon  ! == iim
-  INTEGER,SAVE :: nbp_lat  ! == jjmp1
-  INTEGER,SAVE :: nbp_lev  ! == llm
-  INTEGER,SAVE :: klon_glo
-
-  INTERFACE grid1dTo2d_glo
-    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
-                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
-		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
-   END INTERFACE 
-
-   INTERFACE grid2dTo1d_glo
-    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
-                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
-		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
-   END INTERFACE 
- 
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
-  IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjp1
-  INTEGER, INTENT(in) :: llm
-  
-    nbp_lon=iim
-    nbp_lat=jjp1
-    nbp_lev=llm
-    klon_glo=(iim*jjp1)-2*(iim-1)
-  
-  ! Ehouarn: handle 1D case:
-  if ((iim.eq.1).and.(jjp1.eq.2)) then
-    nbp_lat=1
-    klon_glo=1
-  endif
-  
-  END SUBROUTINE init_grid_phy_lmdz
-  
-  
-  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_i
-  
-
-  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_i1
-
-  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_i2
-  
-  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_i3
-
-
-  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_r
-  
-
-  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_r1
-
-  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_r2
-  
-  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_l
-  
-
-  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_l1
-
-  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_l2
-  
-  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_l3  
-  
-    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_i
-  
-
-  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_i1
-
-  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_i2
-  
-  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_r
-  
-
-  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_r1
-
-  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_r2
-  
-  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_r3
-
-
-
-  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_l
-  
-
-  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_l1
-
-  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_l2
-  
-  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_l3
-
-!---------------------------------------------------------------- 
-!  fonctions generiques (privees)
-!---------------------------------------------------------------- 
-  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_igen   
-
-
-  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-   
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_rgen   
-
-  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_lgen     
-  
-  
-  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_igen   
-  
-  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_rgen 
-    
-  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_lgen   
-
-END MODULE mod_grid_phy_lmdz
Index: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,211 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_mpi_data
-  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
-  
-  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
-
-      ! Ehouarn: handle 1D case:
-      if (klon_glo.eq.1) then
-        klon_mpi_para_end(i) = 1
-        klon_mpi_para_nb(i) = 1
-        ij_para_end(i) = 1
-        jj_para_end(i) = 1
-        ii_para_end(i) = 1
-      endif
-
-      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(*,*) 'ii_begin =', ii_begin
-    WRITE(*,*) 'ii_end =', ii_end
-    WRITE(*,*) 'jj_begin =',jj_begin
-    WRITE(*,*) 'jj_end =', jj_end
-    WRITE(*,*) 'jj_nb =', jj_nb
-    WRITE(*,*) 'ij_begin =', ij_begin
-    WRITE(*,*) 'ij_end =', ij_end
-    WRITE(*,*) 'ij_nb =', ij_nb
-    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
-    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
-    WRITE(*,*) 'klon_mpi =', klon_mpi
-    WRITE(*,*) 'jj_para_nb =', jj_para_nb
-    WRITE(*,*) 'jj_para_begin =', jj_para_begin
-    WRITE(*,*) 'jj_para_end =', jj_para_end
-    WRITE(*,*) 'ii_para_begin =', ii_para_begin
-    WRITE(*,*) 'ii_para_end =', ii_para_end
-    WRITE(*,*) 'ij_para_nb =', ij_para_nb
-    WRITE(*,*) 'ij_para_begin =', ij_para_begin
-    WRITE(*,*) 'ij_para_end =', ij_para_end
-    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
-    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
-    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
-    WRITE(*,*) 'mpi_rank =', mpi_rank
-    WRITE(*,*) 'mpi_size =', mpi_size
-    WRITE(*,*) 'mpi_root =', mpi_root
-    WRITE(*,*) 'is_mpi_root =', is_mpi_root
-    WRITE(*,*) 'is_north_pole =', is_north_pole
-    WRITE(*,*) 'is_south_pole =', is_south_pole
-    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
-  
-  END SUBROUTINE print_module_data
-  
-END MODULE mod_phys_lmdz_mpi_data
Index: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1906 +1,0 @@
-!
-!$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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid2dTo1d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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, only: klon_glo, grid1dTo2d_glo
-    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)
-    if (ierr.ne.MPI_SUCCESS) then
-      write(*,*) "bcast_mpi error: ierr=",ierr
-      stop
-    endif
-#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: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-!$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(*,*)'--------> TASK ',omp_rank
-  WRITE(*,*)'omp_size =',omp_size
-  WRITE(*,*)'omp_rank =',omp_rank
-  WRITE(*,*)'is_omp_root =',is_omp_root
-  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
-  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
-  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
-  WRITE(*,*)'klon_omp =',klon_omp
-  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
-  WRITE(*,*)'klon_omp_end =',klon_omp_end    
-!$OMP END CRITICAL
-
-  END SUBROUTINE Print_module_data
-END MODULE mod_phys_lmdz_omp_data
Index: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1057 +1,0 @@
-!
-!$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, only: klon_omp, klon_omp_begin
-    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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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, only: klon_omp, klon_omp_begin
-  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: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,114 +1,0 @@
-!
-!$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, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
-                               grid1dTo2d_glo, grid2dTo1d_glo
-  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(*,*) "------> 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(*,*) "------> 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(*,*) "------> Checksum =",Checksum," MUST BE 0"
-!$OMP END MASTER
-    ENDIF
-    
-     
-   END SUBROUTINE Test_transfert
-  
-END MODULE mod_phys_lmdz_para
-    
Index: unk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,1275 +1,0 @@
-!
-!$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: unk/LMDZ.MARS/libf/phymars/newstart.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/newstart.F	(revision 1402)
+++ 	(revision )
@@ -1,1783 +1,0 @@
-C======================================================================
-      PROGRAM newstart
-c=======================================================================
-c
-c
-c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
-c   ------
-c             Derniere modif : 12/03
-c
-c
-c   Objet:  Create or modify the initial state for the LMD Mars GCM
-c   -----           (fichiers NetCDF start et startfi)
-c
-c
-c=======================================================================
-
-      use ioipsl_getincom, only: getin 
-      use infotrac, only: iniadvtrac, nqtot, tname
-      use tracer_mod, only: noms, mmol,
-     &                      igcm_dust_number, igcm_dust_mass,
-     &                      igcm_ccn_number, igcm_ccn_mass,
-     &                      igcm_h2o_vap, igcm_h2o_ice, igcm_co2,
-     &                      igcm_n2, igcm_ar, igcm_o2, igcm_co
-      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
-     &                     albedodat, z0_default, qsurf, tsurf,
-     &                     co2ice, emis
-      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx, tsoil
-      use control_mod, only: day_step, iphysiq, anneeref
-      use phyredem, only: physdem0, physdem1
-      use iostart, only: open_startphy
-      use comgeomphy, only: initcomgeomphy
-!      use planete_h
-      use dimradmars_mod, only: tauscaling
-      use turb_mod, only: q2
-      use comgeomfi_h, only: ini_fillgeom
-
-
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "description.h"
-#include "ener.h"
-#include "temps.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-#include "serre.h"
-#include "netcdf.inc"
-#include "datafile.h"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-c Variables dimension du fichier "start_archive"
-c------------------------------------
-      CHARACTER	relief*3
-
-c et autres:
-c----------
-
-c Variables pour les lectures NetCDF des fichiers "start_archive" 
-c--------------------------------------------------
-      INTEGER nid_dyn, nid_fi,nid,nvarid
-      INTEGER tab0
-
-      REAL  date
-      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
-
-c Variable histoire 
-c------------------
-      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL phis(iip1,jjp1)
-      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-      REAL pks(iip1,jjp1)
-      REAL w(iip1,jjp1,llm+1)
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
-      REAL phi(iip1,jjp1,llm)
-
-      integer klatdat,klongdat
-      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
-      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
-      real z0S(iip1,jjp1)
-
-c variable physique
-c------------------
-      REAL tauscadyn(iip1,jjp1) ! dust conversion factor on the dynamics grid
-      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
-      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
-      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
-      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
-
-      INTEGER i,j,l,isoil,ig,idum
-      real mugaz ! molar mass of the atmosphere
-
-      integer ierr  !, nbetat
-
-c Variables on the new grid along scalar points 
-c------------------------------------------------------
-!      REAL p(iip1,jjp1)
-      REAL t(iip1,jjp1,llm)
-      real phisold_newgrid(iip1,jjp1)
-      REAL :: teta(iip1, jjp1, llm)
-      REAL :: pk(iip1,jjp1,llm)
-      REAL :: pkf(iip1,jjp1,llm)
-      REAL :: ps(iip1, jjp1)
-      REAL :: masse(iip1,jjp1,llm)
-      REAL :: xpn,xps,xppn(iim),xpps(iim)
-      REAL :: p3d(iip1, jjp1, llm+1)
-      REAL :: beta(iip1,jjp1,llm)
-!      REAL dteta(ip1jmp1,llm)
-
-c Variable de l'ancienne grille 
-c------------------------------
-      real time
-      real tab_cntrl(100)
-      real tab_cntrl_bis(100)
-
-c variables diverses
-c-------------------
-      real choix_1 ! ==0 : read start_archive file ; ==1: read start files
-      character*80      fichnom
-      integer Lmodif,iq
-      integer flagthermo, flagh2o
-      character modif*20
-      real z_reel(iip1,jjp1)
-      real tsud,albsud,alb_bb,ith_bb,Tiso
-      real ptoto,pcap,patm,airetot,ptotn,patmn
-!      real ssum
-      character*1 yes
-      logical :: flagiso=.false. ,  flagps0=.false.
-      real val, val2, val3 ! to store temporary variables
-      real :: iceith=2000 ! thermal inertia of subterranean ice
-      real :: iceithN,iceithS ! values of thermal inertias in N & S hemispheres
-      integer iref,jref
-
-      INTEGER :: itau
-      
-      INTEGER :: numvanle
-      character(len=50) :: txt ! to store some text
-      integer :: count
-      real :: profile(llm+1) ! to store an atmospheric profile + surface value
-
-! MONS data:
-      real :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
-      real :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
-      ! coefficient to apply to convert d21 to 'true' depth (m)
-      real :: MONS_coeff
-      real :: MONS_coeffS ! coeff for southern hemisphere
-      real :: MONS_coeffN ! coeff for northern hemisphere
-!      real,parameter :: icedepthmin=1.e-3 ! Ice begins at most at that depth
-! Reference position for composition
-      real :: latref,lonref,dlatmin,dlonmin
-! Variable used to change composition
-      real :: Svmr,Smmr,Smmr_old,Smmr_new,Sn
-      real :: Mair_old,Mair_new,vmr_old,vmr_new
-      real,allocatable :: coefvmr(:)  ! Correction coefficient when changing composition
-      integer :: iloc(1), iqmax
-
-c sortie visu pour les champs dynamiques
-c---------------------------------------
-!      INTEGER :: visuid
-!      real :: time_step,t_ops,t_wrt
-!      CHARACTER*80 :: visu_file
-
-      cpp    = 744.499 ! for Mars, instead of 1004.70885 (Earth)
-      preff  = 610.    ! for Mars, instead of 101325. (Earth)
-      pa= 20           ! for Mars, instead of 500 (Earth)
-
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-! allocate arrays
-      allocate(q(iip1,jjp1,llm,nqtot))
-      allocate(coefvmr(nqtot))
-
-c=======================================================================
-c   Choice of the start file(s) to use
-c=======================================================================
-
-      write(*,*) 'From which kind of files do you want to create new',
-     .  'start and startfi files'
-      write(*,*) '    0 - from a file start_archive'
-      write(*,*) '    1 - from files start and startfi'
- 
-c-----------------------------------------------------------------------
-c   Open file(s) to modify (start or start_archive)
-c-----------------------------------------------------------------------
-
-      DO
-         read(*,*,iostat=ierr) choix_1
-         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
-      ENDDO
-
-c     Open start_archive
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start_archive.nc'
-        write(*,*)
-        fichnom = 'start_archive.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-        tab0 = 50 
-        Lmodif = 1
-
-c     OR open start and startfi files
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      else
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start.nc and ./startfi.nc'
-        write(*,*)
-        fichnom = 'start.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
- 
-        fichnom = 'startfi.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-
-        tab0 = 0 
-        Lmodif = 0
-
-      endif
-
-c-----------------------------------------------------------------------
-c Lecture du tableau des parametres du run (pour la dynamique)
-c-----------------------------------------------------------------------
-
-      if (choix_1.eq.0) then
-
-        write(*,*) 'reading 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
-      else if (choix_1.eq.1) then
-
-        write(*,*) 'reading tab_cntrl START'
-c
-        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
-#else
-        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
-#endif
-c
-        write(*,*) 'reading tab_cntrl STARTFI'
-c
-        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
-#else
-        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
-#endif
-c
-        do i=1,50
-          tab_cntrl(i+50)=tab_cntrl_bis(i)
-        enddo
-      write(*,*) 'printing tab_cntrl', tab_cntrl
-      do i=1,100
-        write(*,*) i,tab_cntrl(i)
-      enddo
-      
-      endif
-c-----------------------------------------------------------------------
-c		Initialisation des constantes dynamique
-c-----------------------------------------------------------------------
-
-      kappa = tab_cntrl(9) 
-      etot0 = tab_cntrl(12)
-      ptot0 = tab_cntrl(13)
-      ztot0 = tab_cntrl(14)
-      stot0 = tab_cntrl(15)
-      ang0 = tab_cntrl(16)
-      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
-      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
-
-c-----------------------------------------------------------------------
-c   Lecture du tab_cntrl et initialisation des constantes physiques
-c  - pour start:  Lmodif = 0 => pas de modifications possibles
-c                  (modif dans le tabfi de readfi + loin)
-c  - pour start_archive:  Lmodif = 1 => modifications possibles
-c-----------------------------------------------------------------------
-      if (choix_1.eq.0) then
-         ! tabfi requires that input file be first opened by open_startphy(fichnom)
-         fichnom = 'start_archive.nc'
-         call open_startphy(fichnom)
-         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_mugaz,p_daysec,time)
-      else if (choix_1.eq.1) then
-         fichnom = 'startfi.nc'
-         call open_startphy(fichnom)
-         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_mugaz,p_daysec,time)
-      endif
-
-      rad = p_rad
-      omeg = p_omeg
-      g = p_g
-      mugaz = p_mugaz
-      daysec = p_daysec
-!      write(*,*) 'aire',aire
-
-
-c=======================================================================
-c  INITIALISATIONS DIVERSES
-c=======================================================================
-
-      day_step=180 !?! Note: day_step is a common in "control.h"
-      CALL defrun_new( 99, .TRUE. )
-      CALL iniconst 
-      CALL inigeom
-      idum=-1
-      idum=0
-
-c Initialisation coordonnees /aires
-c -------------------------------
-! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
-!       rlatu() and rlonv() are given in radians
-      latfi(1)=rlatu(1)
-      lonfi(1)=0.
-      DO j=2,jjm
-         DO i=1,iim
-            latfi((j-2)*iim+1+i)=rlatu(j)
-            lonfi((j-2)*iim+1+i)=rlonv(i)
-         ENDDO
-      ENDDO
-      latfi(ngridmx)=rlatu(jjp1)
-      lonfi(ngridmx)=0.
-      
-      ! build airefi(), mesh area on physics grid
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-      ! Poles are single points on physics grid
-      airefi(1)=sum(aire(1:iim,1))
-      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
-
-! also initialize various physics flags/settings which might be needed
-!    (for instance initracer needs to know about some flags, and/or
-!      'datafile' path may be changed by user)
-      call phys_state_var_init(ngridmx,llm,nqtot,
-     .                         daysec,dtphys,rad,g,r,cpp)
-      call ini_fillgeom(ngridmx,latfi,lonfi,airefi)
-      call conf_phys(ngridmx,llm,nqtot)
-
-c=======================================================================
-c   lecture topographie, albedo, inertie thermique, relief sous-maille
-c=======================================================================
-
-      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
-                              ! surface.dat dans le cas des start
-
-c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
-c       write(*,*)
-c       write(*,*) 'choix du relief (mola,pla)'
-c       write(*,*) '(Topographie MGS MOLA, plat)'
-c       read(*,fmt='(a3)') relief
-        relief="mola"
-c     enddo
-
-      CALL datareadnc(relief,phis,alb,surfith,z0S,
-     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
-
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-!      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,z0S,z0)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
-
-      endif ! of if (choix_1.ne.1)
-
-
-c=======================================================================
-c  Lecture des fichiers (start ou start_archive)
-c=======================================================================
-
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Reading file START_ARCHIVE'
-        CALL lect_start_archive(ngridmx,llm,nqtot,
-     &   date,tsurf,tsoil,emis,q2,
-     &   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,
-     &   tauscaling,surfith,nid)
-        write(*,*) "OK, read start_archive file"
-	! copy soil thermal inertia
-	ithfi(:,:)=inertiedat(:,:)
-	
-        ierr= NF_CLOSE(nid)
-
-      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
-                                  !  permet de changer les valeurs du 
-                                  !  tab_cntrl Lmodif=1
-        tab0=0
-        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
-        write(*,*) 'Reading file START'
-        fichnom = 'start.nc'
-        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,time)
-
-        write(*,*) 'Reading file STARTFI'
-        fichnom = 'startfi.nc'
-        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
-     .        day_ini,time,
-     .        tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
-        
-        ! copy albedo and soil thermal inertia
-        do i=1,ngridmx
-          albfi(i) = albedodat(i)
-	  do j=1,nsoilmx
-           ithfi(i,j) = inertiedat(i,j)
-	  enddo
-        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
-        ! be neede later on if reinitializing soil thermal inertia
-          surfithfi(i)=ithfi(i,1)
-        enddo
-
-      else 
-        CALL exit(1)
-      endif
-
-      dtvr   = daysec/REAL(day_step)
-      dtphys   = dtvr * REAL(iphysiq)
-
-c=======================================================================
-c 
-c=======================================================================
-! If tracer names follow 'old' convention (q01, q02, ...) then
-! rename them
-      count=0
-      do iq=1,nqtot
-        txt=" "
-        write(txt,'(a1,i2.2)') 'q',iq
-        if (txt.eq.tname(iq)) then
-          count=count+1
-        endif
-      enddo ! of do iq=1,nqtot
-      
-      ! initialize tracer names noms(:) and indexes (igcm_co2, igcm_h2o_vap, ...)
-      call initracer(ngridmx,nqtot,qsurf)
-      
-      if (count.eq.nqtot) then
-        write(*,*) 'Newstart: updating tracer names'
-        ! copy noms(:) to tname(:) to have matching tracer names in physics
-        ! and dynamics
-        tname(1:nqtot)=noms(1:nqtot)
-      endif
-
-c=======================================================================
-c 
-c=======================================================================
-
-      do ! infinite loop on list of changes
-
-      write(*,*)
-      write(*,*)
-      write(*,*) 'List of possible changes :'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      write(*,*)
-      write(*,*) 'flat         : no topography ("aquaplanet")'
-      write(*,*) 'bilball      : uniform albedo and thermal inertia'
-      write(*,*) 'z0           : set a uniform surface roughness length'
-      write(*,*) 'coldspole    : cold subsurface and high albedo at
-     $ S.Pole'
-      write(*,*) 'qname        : change tracer name'
-      write(*,*) 'q=0          : ALL tracer =zero'
-      write(*,*) 'q=x          : give a specific uniform value to one
-     $ tracer'
-      write(*,*) 'q=profile    : specify a profile for a tracer'
-      write(*,*) 'freedust     : rescale dust to a true value'
-      write(*,*) 'ini_q        : tracers initialization for chemistry
-     $ and water vapour'
-      write(*,*) 'ini_q-h2o    : tracers initialization for chemistry
-     $ only'
-      write(*,*) 'composition  : change atm main composition: CO2,N2,Ar,
-     $ O2,CO'
-      write(*,*) 'ini_h2osurf  : reinitialize surface water ice '
-      write(*,*) 'noglacier    : Remove tropical H2O ice if |lat|<45'
-      write(*,*) 'watercapn    : H20 ice on permanent N polar cap '
-      write(*,*) 'watercaps    : H20 ice on permanent S polar cap '
-      write(*,*) 'wetstart     : start with a wet atmosphere'
-      write(*,*) 'isotherm     : Isothermal Temperatures, wind set to
-     $ zero'
-      write(*,*) 'co2ice=0     : remove CO2 polar cap'
-      write(*,*) 'ptot         : change total pressure'
-      write(*,*) 'therm_ini_s  : set soil thermal inertia to reference
-     $ surface values'
-      write(*,*) 'subsoilice_n : put deep underground ice layer in
-     $ northern hemisphere'
-      write(*,*) 'subsoilice_s : put deep underground ice layer in
-     $ southern hemisphere'
-      write(*,*) 'mons_ice     : put underground ice layer according
-     $ to MONS derived data'
-
-        write(*,*)
-        write(*,*) 'Change to perform ?'
-        write(*,*) '   (enter keyword or return to end)'
-        write(*,*)
-
-        read(*,fmt='(a20)') modif
-        if (modif(1:1) .eq. ' ') exit ! exit loop on changes
-
-        write(*,*)
-        write(*,*) trim(modif) , ' : '
-
-c       'flat : no topography ("aquaplanet")'
-c       -------------------------------------
-        if (trim(modif) .eq. 'flat') then
-c         set topo to zero 
-          CALL initial0(ip1jmp1,z_reel)
-          CALL multscal(ip1jmp1,z_reel,g,phis)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-          write(*,*) 'topography set to zero.'
-          write(*,*) 'WARNING : the subgrid topography parameters',
-     &    ' were not set to zero ! => set calllott to F'                    
-
-c        Choice for surface pressure
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to choose homogeneous surface',
-     &                 'pressure (y) or let newstart interpolate ',
-     &                 ' the previous field  (n)?'
-             read(*,fmt='(a)') yes
-         end do
-         if (yes.eq.'y') then
-           flagps0=.true.
-           write(*,*) 'New value for ps (Pa) ?'
- 201       read(*,*,iostat=ierr) patm
-            if(ierr.ne.0) goto 201
-             write(*,*)
-             write(*,*) ' new ps everywhere (Pa) = ', patm
-             write(*,*)
-             do j=1,jjp1
-               do i=1,iip1
-                 ps(i,j)=patm
-               enddo
-             enddo
-         end if
-
-c       bilball : albedo, inertie thermique uniforme
-c       --------------------------------------------
-        else if (trim(modif) .eq. 'bilball') then
-          write(*,*) 'constante albedo and iner.therm:'
-          write(*,*) 'New value for albedo (ex: 0.25) ?'
- 101      read(*,*,iostat=ierr) alb_bb
-          if(ierr.ne.0) goto 101
-          write(*,*)
-          write(*,*) ' uniform albedo (new value):',alb_bb
-          write(*,*)
-
-          write(*,*) 'New value for thermal inertia (eg: 247) ?'
- 102      read(*,*,iostat=ierr) ith_bb
-          if(ierr.ne.0) goto 102
-          write(*,*) 'uniform thermal inertia (new value):',ith_bb
-          DO j=1,jjp1
-             DO i=1,iip1
-                alb(i,j) = alb_bb	! albedo
-		do isoil=1,nsoilmx
-                  ith(i,j,isoil) = ith_bb	! thermal inertia
-		enddo
-             END DO
-          END DO
-!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-        
-         ! also reset surface roughness length to default value
-         write(*,*) 'surface roughness length set to:',z0_default,' m'
-         z0(:)=z0_default
-
-!       z0 : set surface roughness length to a constant value
-!       -----------------------------------------------------
-        else if (trim(modif) .eq. 'z0') then
-          write(*,*) 'set a uniform surface roughness length'
-          write(*,*) ' value for z0_default (ex: ',z0_default,')?'
-          ierr=1
-          do while (ierr.ne.0)
-            read(*,*,iostat=ierr) z0_default
-          enddo
-          z0(:)=z0_default
-
-c       coldspole : sous-sol de la calotte sud toujours froid
-c       -----------------------------------------------------
-        else if (trim(modif) .eq. 'coldspole') then
-          write(*,*)'new value for the subsurface temperature',
-     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
- 103      read(*,*,iostat=ierr) tsud
-          if(ierr.ne.0) goto 103
-          write(*,*)
-          write(*,*) ' new value of the subsurface temperature:',tsud
-c         nouvelle temperature sous la calotte permanente
-          do l=2,nsoilmx
-               tsoil(ngridmx,l) =  tsud
-          end do
-
-
-          write(*,*)'new value for the albedo',
-     &   'of the permanent southern polar cap ? (eg: 0.75)'
- 104      read(*,*,iostat=ierr) albsud
-          if(ierr.ne.0) goto 104
-          write(*,*)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c         Option 1:  only the albedo of the pole is modified :    
-          albfi(ngridmx)=albsud
-          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
-     &    albfi(ngridmx)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
-c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
-c           DO j=1,jjp1
-c             DO i=1,iip1
-c                ig=1+(j-2)*iim +i
-c                if(j.eq.1) ig=1
-c                if(j.eq.jjp1) ig=ngridmx
-c                if ((rlatu(j)*180./pi.lt.-84.).and.
-c     &            (rlatu(j)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.lt.0.))         then
-cc    albedo de la calotte permanente fixe a albsud
-c                   alb(i,j)=albsud
-c                   write(*,*) 'lat=',rlatu(j)*180./pi,
-c     &                      ' lon=',rlonv(i)*180./pi
-cc     fin de la condition sur les limites de la calotte permanente
-c                end if
-c             ENDDO
-c          ENDDO
-c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-
-c       ptot : Modification of the total pressure: ice + current atmosphere 
-c       -------------------------------------------------------------------
-        else if (trim(modif) .eq. 'ptot') then
-
-c         calcul de la pression totale glace + atm actuelle
-          patm=0.
-          airetot=0.
-          pcap=0.
-          DO j=1,jjp1
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-                patm = patm + ps(i,j)*aire(i,j)
-                airetot= airetot + aire(i,j)
-                pcap = pcap + aire(i,j)*co2ice(ig)*g
-             ENDDO
-          ENDDO
-          ptoto = pcap + patm
-
-          print*,'Current total pressure at surface (co2 ice + atm) ',
-     &       ptoto/airetot
-
-          print*,'new value?'
-          read(*,*) ptotn
-          ptotn=ptotn*airetot
-          patmn=ptotn-pcap
-          print*,'ptoto,patm,ptotn,patmn'
-          print*,ptoto,patm,ptotn,patmn
-          print*,'Mult. factor for pressure (atm only)', patmn/patm
-          do j=1,jjp1
-             do i=1,iip1
-                ps(i,j)=ps(i,j)*patmn/patm
-             enddo
-          enddo
-
-c        Correction pour la conservation des traceurs
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to conserve tracer total mass (y)',
-     &              ' or tracer mixing ratio (n) ?'
-             read(*,fmt='(a)') yes
-         end do
-
-         if (yes.eq.'y') then
-           write(*,*) 'OK : conservation of tracer total mass'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-          else
-            write(*,*) 'OK : conservation of tracer mixing ratio'
-          end if
-
-c       qname : change tracer name
-c       --------------------------
-        else if (trim(modif).eq.'qname') then
-         yes='y'
-         do while (yes.eq.'y')
-          write(*,*) 'Which tracer name do you want to change ?'
-          do iq=1,nqtot
-            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
-          enddo
-          write(*,'(a35,i3)')
-     &            '(enter tracer number; between 1 and ',nqtot
-          write(*,*)' or any other value to quit this option)'
-          read(*,*) iq
-          if ((iq.ge.1).and.(iq.le.nqtot)) then
-            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
-            read(*,*) txt
-            tname(iq)=txt
-            write(*,*)'Do you want to change another tracer name (y/n)?'
-            read(*,'(a)') yes 
-          else
-! inapropiate value of iq; quit this option
-            yes='n'
-          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
-         enddo ! of do while (yes.ne.'y')
-
-c       q=0 : set tracers to zero
-c       -------------------------
-        else if (trim(modif) .eq. 'q=0') then
-c          mise a 0 des q (traceurs)
-          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=1.e-30
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-
-c          set surface tracers to zero
-           DO iq =1, nqtot
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=0.
-             ENDDO
-           ENDDO
-
-c       q=x : initialise tracer manually 
-c       --------------------------------
-        else if (trim(modif) .eq. 'q=x') then
-             write(*,*) 'Which tracer do you want to modify ?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             if ((iq.lt.1).or.(iq.gt.nqtot)) then
-               ! wrong value for iq, go back to menu
-               write(*,*) "wrong input value:",iq
-               cycle
-             endif
-             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
-     &                 ' ? (kg/kg)'
-             read(*,*) val
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=val
-                  ENDDO
-               ENDDO
-             ENDDO
-             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
-     &                   ' ? (kg/m2)'
-             read(*,*) val
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=val
-             ENDDO
-
-c       q=profile : initialize tracer with a given profile
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'q=profile') then
-             write(*,*) 'Tracer profile will be sought in ASCII file'
-             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
-             write(*,*) "(one value per line in file; starting with"
-             write(*,*) "surface value, the 1st atmospheric layer"
-             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
-             write(*,*) 'Which tracer do you want to set?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             if ((iq.lt.1).or.(iq.gt.nqtot)) then
-               ! wrong value for iq, go back to menu
-               write(*,*) "wrong input value:",iq
-               cycle
-             endif
-             ! look for input file 'profile_tracer'
-             txt="profile_"//trim(tname(iq))
-             open(41,file=trim(txt),status='old',form='formatted',
-     &            iostat=ierr)
-             if (ierr.eq.0) then
-               ! OK, found file 'profile_...', load the profile
-               do l=1,llm+1
-                 read(41,*,iostat=ierr) profile(l)
-                 if (ierr.ne.0) then ! something went wrong
-                   exit ! quit loop
-                 endif
-               enddo
-               if (ierr.eq.0) then
-                 ! initialize tracer values
-                 qsurf(:,iq)=profile(1)
-                 do l=1,llm
-                   q(:,:,l,iq)=profile(l+1)
-                 enddo
-                 write(*,*)'OK, tracer ',trim(tname(iq)),
-     &               ' initialized ','using values from file ',trim(txt)
-               else
-                 write(*,*)'problem reading file ',trim(txt),' !'
-                 write(*,*)'No modifications to tracer ',trim(tname(iq))
-               endif
-             else
-               write(*,*)'Could not find file ',trim(txt),' !'
-               write(*,*)'No modifications to tracer ',trim(tname(iq))
-             endif
-             
-c       convert dust from virtual to true values
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'freedust') then
-         if (minval(tauscaling) .lt. 0) then
-           write(*,*) 'WARNING conversion factor negative'
-           write(*,*) 'This is probably because it was not present
-     &in the file'
-           write(*,*) 'A constant conversion is used instead.'
-           tauscaling(:) = 1.e-3
-         endif
-         CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscadyn)
-          do l=1,llm
-            do j=1,jjp1
-              do i=1,iip1
-                if (igcm_dust_number .ne. 0) 
-     &            q(i,j,l,igcm_dust_number) =
-     &            q(i,j,l,igcm_dust_number) * tauscadyn(i,j)
-                if (igcm_dust_mass .ne. 0) 
-     &            q(i,j,l,igcm_dust_mass) =
-     &            q(i,j,l,igcm_dust_mass) * tauscadyn(i,j)
-                if (igcm_ccn_number .ne. 0) 
-     &            q(i,j,l,igcm_ccn_number) =
-     &            q(i,j,l,igcm_ccn_number) * tauscadyn(i,j)
-                if (igcm_ccn_mass .ne. 0) 
-     &            q(i,j,l,igcm_ccn_mass) =
-     &            q(i,j,l,igcm_ccn_mass) * tauscadyn(i,j)
-              end do
-            end do
-          end do
-
-          tauscaling(:) = 1.
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'done rescaling to true vale'
-
-c       ini_q : Initialize tracers for chemistry
-c       -----------------------------------------------
-        else if (trim(modif) .eq. 'ini_q') then
-          flagh2o    = 1
-          flagthermo = 0
-          yes=' '
-c         For more than 32 layers, possible to initiate thermosphere only     
-          if (llm.gt.32) then 
-            do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*)'',
-     &     'initialisation for thermosphere only? (y/n)'
-            read(*,fmt='(a)') yes
-            if (yes.eq.'y') then
-            flagthermo=1 
-            else
-            flagthermo=0
-            endif
-            enddo  
-          endif
-          
-          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
-     &                          flagh2o, flagthermo)
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'inichim_newstart: chemical species and
-     $ water vapour initialised'
-
-c       ini_q-h2o : as above except for the water vapour tracer 
-c       ------------------------------------------------------
-        else if (trim(modif) .eq. 'ini_q-h2o') then
-          flagh2o    = 0
-          flagthermo = 0
-          yes=' '
-          ! for more than 32 layers, possible to initiate thermosphere only     
-          if(llm.gt.32) then
-            do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*)'',
-     &      'initialisation for thermosphere only? (y/n)'
-            read(*,fmt='(a)') yes
-            if (yes.eq.'y') then 
-            flagthermo=1 
-            else
-            flagthermo=0
-            endif
-            enddo
-          endif
-
-          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
-     &                          flagh2o, flagthermo)
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'inichim_newstart: chemical species initialised
-     $ (except water vapour)'
-
-c      composition : change main composition: CO2,N2,Ar,O2,CO (FF 03/2014)
-c      --------------------------------------------------------
-       else if (trim(modif) .eq. 'composition') then
-          write(*,*) "Lat (degN)  lon (degE) of the reference site ?"
-          write(*,*) "e.g. MSL : -4.5  137.  "
- 301      read(*,*,iostat=ierr) latref, lonref
-          if(ierr.ne.0) goto 301
-
-
-        !  Select GCM point close to reference site
-          dlonmin =90.
-          DO i=1,iip1-1
-             if (abs(rlonv(i)*180./pi -lonref).lt.dlonmin)then
-                iref=i
-                dlonmin=abs(rlonv(i)*180./pi -lonref)
-             end if   
-          ENDDO
-          dlatmin =45.
-          DO j=1,jjp1
-             if (abs(rlatu(j)*180./pi -latref).lt.dlatmin)then
-                jref=j
-                dlatmin=abs(rlatu(j)*180./pi -latref)
-             end if   
-          ENDDO
-          write(*,*) "In GCM : lat= " ,  rlatu(jref)*180./pi
-          write(*,*) "In GCM : lon= " ,  rlonv(iref)*180./pi
-          write(*,*)
-
-        ! Compute air molar mass at reference site
-          Smmr=0
-          Sn = 0
-          do iq=1,nqtot 
-             if ((iq.eq.igcm_co2).or.(iq.eq.igcm_n2)
-     &      .or. (iq.eq.igcm_ar).or.(iq.eq.igcm_o2)
-     &      .or. (iq.eq.igcm_co)) then
-                 Smmr=Smmr+q(iref,jref,1,iq)
-                 Sn=Sn+q(iref,jref,1,iq)/mmol(iq) 
-             end if
-          end do
-          write(*,*) "At reference site :  "
-          write(*,*) "Sum of mass mix. ratio (should be about 1)=",Smmr
-          Mair_old =Smmr/Sn
-          write(*,*)
-     &     "Air molar mass (g/mol) at reference site= ",Mair_old
-
-        ! Ask for new volume mixing ratio at reference site
-          Svmr =0.
-          Sn =0.
-          do iq=1,nqtot 
-           coefvmr(iq) = 1.
-           if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &     .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-
-             vmr_old=q(iref,jref,1,iq)*Mair_old/mmol(iq)  
-             write(*,*) "Previous vmr("//trim(tname(iq))//")= ", vmr_old
-
-              if (iq.eq.igcm_n2) then
-                write(*,*) "New vmr(n2)? (MSL: 2.03e-02 at Ls~184)"
-              endif
-              if (iq.eq.igcm_ar) then
-                write(*,*) "New vmr(ar)? (MSL: 2.07e-02 at Ls~184)"
-              endif
-              if (iq.eq.igcm_o2) then
-                write(*,*) "New vmr(o2)? (MSL: 1.73e-03 at Ls~184)"
-              endif
-              if (iq.eq.igcm_co) then
-                write(*,*) "New vmr(co)? (MSL: 7.49e-04 at Ls~184)"
-              endif
- 302          read(*,*,iostat=ierr) vmr_new
-              if(ierr.ne.0) goto 302
-              write(*,*) "New vmr("//trim(tname(iq))//")= ",vmr_new
-              write(*,*) 
-              coefvmr(iq) = vmr_new/vmr_old
-              Svmr=Svmr+vmr_new
-              Sn=Sn+vmr_new*mmol(iq)
-           end if
-          enddo ! of do iq=1,nqtot 
-      !  Estimation of new Air molar mass at reference site (assuming vmr_co2 = 1-Svmr)
-          Mair_new = Sn + (1-Svmr)*mmol(igcm_co2) 
-          write(*,*)
-     &     "NEW Air molar mass (g/mol) at reference site= ",Mair_new
-
-        ! Compute mass mixing ratio changes  
-          do iq=1,nqtot  
-            if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &          .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-             write(*,*) "Everywhere mmr("//trim(tname(iq))//
-     &        ") is multiplied by ",coefvmr(iq)*Mair_old/Mair_new
-            end if
-          end do
-
-        ! Recompute mass mixing ratios everywhere, and adjust mmr of most abundant species
-        ! to keep sum of mmr constant.
-          do l=1,llm
-           do j=1,jjp1
-            do i=1,iip1
-              Smmr_old = 0.
-              Smmr_new = 0.
-              do iq=1,nqtot  
-                if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &         .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-                   Smmr_old = Smmr_old + q(i,j,l,iq) ! sum of old mmr 
-                   q(i,j,l,iq)=q(i,j,l,iq)*coefvmr(iq)*Mair_old/Mair_new
-                   Smmr_new = Smmr_new + q(i,j,l,iq) ! sum of new mmr
-                end if 
-              enddo
-              iloc = maxloc(q(i,j,l,:))
-              iqmax = iloc(1)
-              q(i,j,l,iqmax) = q(i,j,l,iqmax) + Smmr_old - Smmr_new
-            enddo
-           enddo
-          enddo
-
-          write(*,*)
-     &   "The most abundant species is modified everywhere to keep "//
-     &   "sum of mmr constant"
-          write(*,*) 'At reference site vmr(CO2)=', 
-     &        q(iref,jref,1,igcm_co2)*Mair_new/mmol(igcm_co2)
-          write(*,*) "Compared to MSL observation: vmr(CO2)= 0.957 "//
-     &   "at Ls=184" 
-
-c      wetstart : wet atmosphere with a north to south gradient
-c      --------------------------------------------------------
-       else if (trim(modif) .eq. 'wetstart') then
-        ! check that there is indeed a water vapor tracer
-        if (igcm_h2o_vap.eq.0) then
-          write(*,*) "No water vapour tracer! Can't use this option"
-          stop
-        endif
-          DO l=1,llm
-            DO j=1,jjp1
-              DO i=1,iip1-1
-                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
-              ENDDO
-              ! We want to have the very same value at lon -180 and lon 180
-              q(iip1,j,l,igcm_h2o_vap) = q(1,j,l,igcm_h2o_vap)
-            ENDDO
-          ENDDO
-
-         write(*,*) 'Water mass mixing ratio at north pole='
-     *               ,q(1,1,1,igcm_h2o_vap)
-         write(*,*) '---------------------------south pole='
-     *               ,q(1,jjp1,1,igcm_h2o_vap)
-
-c      ini_h2osurf : reinitialize surface water ice
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'ini_h2osurf') then
-          write(*,*)'max surface ice left?(e.g. 0.2 kg/m2=200microns)'
- 207      read(*,*,iostat=ierr) val
-          if(ierr.ne.0) goto 207
-          write(*,*)'also set negative values of surf ice to 0'
-           do ig=1,ngridmx
-              qsurf(ig,igcm_h2o_ice)=min(val,qsurf(ig,igcm_h2o_ice))
-              qsurf(ig,igcm_h2o_ice)=max(0.,qsurf(ig,igcm_h2o_ice))
-           end do
-
-c      noglacier : remove tropical water ice (to initialize high res sim)
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'noglacier') then
-           do ig=1,ngridmx
-             j=(ig-2)/iim +2
-              if(ig.eq.1) j=1
-              write(*,*) 'OK: remove surface ice for |lat|<45'
-              if (abs(rlatu(j)*180./pi).lt.45.) then
-                   qsurf(ig,igcm_h2o_ice)=0.
-              end if
-           end do
-
-
-c      watercapn : H20 ice on permanent northern cap
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'watercapn') then
-           do ig=1,ngridmx
-             j=(ig-2)/iim +2
-              if(ig.eq.1) j=1
-              if (rlatu(j)*180./pi.gt.80.) then
-                   qsurf(ig,igcm_h2o_ice)=1.e5
-                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
-     &              qsurf(ig,igcm_h2o_ice)
-                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
-     &              rlatv(j)*180./pi
-                end if
-           enddo
-
-c      watercaps : H20 ice on permanent southern cap
-c      -------------------------------------------------
-        else if (trim(modif) .eq. 'watercaps') then
-           do ig=1,ngridmx
-               j=(ig-2)/iim +2
-               if(ig.eq.1) j=1
-               if (rlatu(j)*180./pi.lt.-80.) then
-                   qsurf(ig,igcm_h2o_ice)=1.e5
-                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
-     &              qsurf(ig,igcm_h2o_ice)
-                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
-     &              rlatv(j-1)*180./pi
-               end if
-           enddo
-
-c       isotherm : Isothermal temperatures and no winds
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'isotherm') then
-
-          write(*,*)'Isothermal temperature of the atmosphere, 
-     &           surface and subsurface'
-          write(*,*) 'Value of this temperature ? :'
- 203      read(*,*,iostat=ierr) Tiso
-          if(ierr.ne.0) goto 203
-
-          do ig=1, ngridmx
-            tsurf(ig) = Tiso
-          end do
-          do l=2,nsoilmx
-            do ig=1, ngridmx
-              tsoil(ig,l) = Tiso
-            end do
-          end do
-          flagiso=.true.
-          call initial0(llm*ip1jmp1,ucov)
-          call initial0(llm*ip1jm,vcov)
-          call initial0(ngridmx*(llm+1),q2)
-
-c       co2ice=0 : remove CO2 polar ice caps'
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'co2ice=0') then
-           do ig=1,ngridmx
-              co2ice(ig)=0
-              emis(ig)=emis(ngridmx/2)
-           end do
-        
-!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
-!       ----------------------------------------------------------------------
-
-	else if (trim(modif).eq.'therm_ini_s') then
-!          write(*,*)"surfithfi(1):",surfithfi(1)
-	  do isoil=1,nsoilmx
-	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
-	  enddo
-          write(*,*)'OK: Soil thermal inertia has been reset to referenc
-     &e surface values'
-!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
-	  ithfi(:,:)=inertiedat(:,:)
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-! Check:
-!         do i=1,iip1
-!           do j=1,jjp1
-!             do isoil=1,nsoilmx
-!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
-!             enddo
-!           enddo
-!	 enddo
-
-!       subsoilice_n: Put deep ice layer in northern hemisphere soil
-!       ------------------------------------------------------------
-
-	else if (trim(modif).eq.'subsoilice_n') then
-
-         write(*,*)'From which latitude (in deg.), up to the north pole,
-     &should we put subterranean ice?'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val
-	  if (ierr.eq.0) then ! got a value
-	    ! do a sanity check
-	    if((val.lt.0.).or.(val.gt.90)) then
-	      write(*,*)'Latitude should be between 0 and 90 deg. !!!'
-	      ierr=1
-	    else ! find corresponding jref (nearest latitude)
-	      ! note: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-	      do j=1,jjp1
-	        if ((rlatu(j)*180./pi.ge.val).and.
-     &              (rlatu(j+1)*180./pi.le.val)) then
-		  ! find which grid point is nearest to val:
-		  if (abs(rlatu(j)*180./pi-val).le.
-     &                abs((rlatu(j+1)*180./pi-val))) then
-		   jref=j
-		  else
-		   jref=j+1
-		  endif
-		 
-		 write(*,*)'Will use nearest grid latitude which is:',
-     &                     rlatu(jref)*180./pi
-		endif
-	      enddo ! of do j=1,jjp1
-	    endif ! of if((val.lt.0.).or.(val.gt.90))
-	  endif !of if (ierr.eq.0)
-	 enddo ! of do while
-
-         ! Build layers() (as in soil_settings.F)
-	 val2=sqrt(mlayer(0)*mlayer(1))
-	 val3=mlayer(1)/mlayer(0)
-	 do isoil=1,nsoilmx
-	   layer(isoil)=val2*(val3**(isoil-1))
-	 enddo
-
-         write(*,*)'At which depth (in m.) does the ice layer begin?'
-         write(*,*)'(currently, the deepest soil layer extends down to:'
-     &              ,layer(nsoilmx),')'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val2
-!	  write(*,*)'val2:',val2,'ierr=',ierr
-	  if (ierr.eq.0) then ! got a value, but do a sanity check
-	    if(val2.gt.layer(nsoilmx)) then
-	      write(*,*)'Depth should be less than ',layer(nsoilmx)
-	      ierr=1
-	    endif
-	    if(val2.lt.layer(1)) then
-	      write(*,*)'Depth should be more than ',layer(1)
-	      ierr=1
-	    endif
-	  endif
-         enddo ! of do while
-	 
-	 ! find the reference index iref the depth corresponds to
-!	 if (val2.lt.layer(1)) then
-!	  iref=1
-!	 else
-	  do isoil=1,nsoilmx-1
-	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
-     &       then
-	     iref=isoil
-	     exit
-	   endif
-	  enddo
-!	 endif
-	 
-!	 write(*,*)'iref:',iref,'  jref:',jref
-!	 write(*,*)'layer',layer
-!	 write(*,*)'mlayer',mlayer
-         
-	 ! thermal inertia of the ice:
-	 ierr=1
-	 do while (ierr.ne.0)
-          write(*,*)'What is the value of subterranean ice thermal inert
-     &ia? (e.g.: 2000)'
-          read(*,*,iostat=ierr)iceith
-	 enddo ! of do while
-	 
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-	 
-	 do j=1,jref
-!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
-	    do i=1,iip1 ! loop on longitudes
-	     ! Build "equivalent" thermal inertia for the mixed layer
-	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
-     &                      ((layer(iref+1)-val2)/(iceith)**2)))
-	     ! Set thermal inertia of lower layers
-	     do isoil=iref+2,nsoilmx
-	      ith(i,j,isoil)=iceith ! ice
-	     enddo
-	    enddo ! of do i=1,iip1 
-	 enddo ! of do j=1,jjp1
-	 
-
-	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-!         do i=1,nsoilmx
-!	  write(*,*)'i:',i,'ithfi(1,i):',ithfi(1,i)
-!	 enddo
-
-	
-!       subsoilice_s: Put deep ice layer in southern hemisphere soil
-!       ------------------------------------------------------------
-
-	else if (trim(modif).eq.'subsoilice_s') then
-
-         write(*,*)'From which latitude (in deg.), down to the south pol
-     &e, should we put subterranean ice?'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val
-	  if (ierr.eq.0) then ! got a value
-	    ! do a sanity check
-	    if((val.gt.0.).or.(val.lt.-90)) then
-	      write(*,*)'Latitude should be between 0 and -90 deg. !!!'
-	      ierr=1
-	    else ! find corresponding jref (nearest latitude)
-	      ! note: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-	      do j=1,jjp1
-	        if ((rlatu(j)*180./pi.ge.val).and.
-     &              (rlatu(j+1)*180./pi.le.val)) then
-		  ! find which grid point is nearest to val:
-		  if (abs(rlatu(j)*180./pi-val).le.
-     &                abs((rlatu(j+1)*180./pi-val))) then
-		   jref=j
-		  else
-		   jref=j+1
-		  endif
-		 
-		 write(*,*)'Will use nearest grid latitude which is:',
-     &                     rlatu(jref)*180./pi
-		endif
-	      enddo ! of do j=1,jjp1
-	    endif ! of if((val.lt.0.).or.(val.gt.90))
-	  endif !of if (ierr.eq.0)
-	 enddo ! of do while
-
-         ! Build layers() (as in soil_settings.F)
-	 val2=sqrt(mlayer(0)*mlayer(1))
-	 val3=mlayer(1)/mlayer(0)
-	 do isoil=1,nsoilmx
-	   layer(isoil)=val2*(val3**(isoil-1))
-	 enddo
-
-         write(*,*)'At which depth (in m.) does the ice layer begin?'
-         write(*,*)'(currently, the deepest soil layer extends down to:'
-     &              ,layer(nsoilmx),')'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val2
-!	  write(*,*)'val2:',val2,'ierr=',ierr
-	  if (ierr.eq.0) then ! got a value, but do a sanity check
-	    if(val2.gt.layer(nsoilmx)) then
-	      write(*,*)'Depth should be less than ',layer(nsoilmx)
-	      ierr=1
-	    endif
-	    if(val2.lt.layer(1)) then
-	      write(*,*)'Depth should be more than ',layer(1)
-	      ierr=1
-	    endif
-	  endif
-         enddo ! of do while
-	 
-	 ! find the reference index iref the depth corresponds to
-	  do isoil=1,nsoilmx-1
-	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
-     &       then
-	     iref=isoil
-	     exit
-	   endif
-	  enddo
-	 
-!	 write(*,*)'iref:',iref,'  jref:',jref
-         
-	 ! thermal inertia of the ice:
-	 ierr=1
-	 do while (ierr.ne.0)
-          write(*,*)'What is the value of subterranean ice thermal inert
-     &ia? (e.g.: 2000)'
-          read(*,*,iostat=ierr)iceith
-	 enddo ! of do while
-	 
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-	 
-	 do j=jref,jjp1
-!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
-	    do i=1,iip1 ! loop on longitudes
-	     ! Build "equivalent" thermal inertia for the mixed layer
-	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
-     &                      ((layer(iref+1)-val2)/(iceith)**2)))
-	     ! Set thermal inertia of lower layers
-	     do isoil=iref+2,nsoilmx
-	      ith(i,j,isoil)=iceith ! ice
-	     enddo
-	    enddo ! of do i=1,iip1 
-	 enddo ! of do j=jref,jjp1
-	 
-
-	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-c       'mons_ice' : use MONS data to build subsurface ice table
-c       --------------------------------------------------------
-        else if (trim(modif).eq.'mons_ice') then
-        
-       ! 1. Load MONS data
-        call load_MONS_data(MONS_Hdn,MONS_d21)
-        
-        ! 2. Get parameters from user
-        ierr=1
-	do while (ierr.ne.0)
-          write(*,*) "Coefficient to apply to MONS 'depth' in Northern",
-     &               " Hemisphere?"
-          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
-          read(*,*,iostat=ierr) MONS_coeffN
-        enddo
-        ierr=1
-	do while (ierr.ne.0)
-          write(*,*) "Coefficient to apply to MONS 'depth' in Southern",
-     &               " Hemisphere?"
-          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
-          read(*,*,iostat=ierr) MONS_coeffS
-        enddo
-        ierr=1
-        do while (ierr.ne.0)
-          write(*,*) "Value of subterranean ice thermal inertia ",
-     &               " in Northern hemisphere?"
-          write(*,*) " (e.g.: 2000, or perhaps 2290)"
-!          read(*,*,iostat=ierr) iceith
-          read(*,*,iostat=ierr) iceithN
-        enddo
-        ierr=1
-        do while (ierr.ne.0)
-          write(*,*) "Value of subterranean ice thermal inertia ",
-     &               " in Southern hemisphere?"
-          write(*,*) " (e.g.: 2000, or perhaps 2290)"
-!          read(*,*,iostat=ierr) iceith
-          read(*,*,iostat=ierr) iceithS
-        enddo
-        
-        ! 3. Build subterranean thermal inertia
-        
-        ! initialise subsurface inertia with reference surface values
-        do isoil=1,nsoilmx
-          ithfi(1:ngridmx,isoil)=surfithfi(1:ngridmx)
-        enddo
-        ! recast ithfi() onto ith()
-	call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-        
-        do i=1,iip1 ! loop on longitudes
-          do j=1,jjp1 ! loop on latitudes
-            ! set MONS_coeff
-            if (rlatu(j).ge.0) then ! northern hemisphere
-              ! N.B: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-              MONS_coeff=MONS_coeffN
-              iceith=iceithN
-            else ! southern hemisphere
-              MONS_coeff=MONS_coeffS
-              iceith=iceithS
-            endif
-            ! check if we should put subterranean ice
-            if (MONS_Hdn(i,j).ge.14.0) then ! no ice if Hdn<14%
-              ! compute depth at which ice lies:
-              val=MONS_d21(i,j)*MONS_coeff
-              ! compute val2= the diurnal skin depth of surface inertia
-              ! assuming a volumetric heat cap. of C=1.e6 J.m-3.K-1
-              val2=ith(i,j,1)*1.e-6*sqrt(88775./3.14159)
-              if (val.lt.val2) then
-                ! ice must be below the (surface inertia) diurnal skin depth
-                val=val2
-              endif
-              if (val.lt.layer(nsoilmx)) then ! subterranean ice
-                ! find the reference index iref that depth corresponds to
-                iref=0
-                do isoil=1,nsoilmx-1
-                 if ((val.ge.layer(isoil)).and.(val.lt.layer(isoil+1)))
-     &             then
-	           iref=isoil
-	           exit
-	         endif
-                enddo
-                ! Build "equivalent" thermal inertia for the mixed layer
-                ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val-layer(iref))/(ith(i,j,iref+1)**2))+
-     &                      ((layer(iref+1)-val)/(iceith)**2)))
-	        ! Set thermal inertia of lower layers
-                do isoil=iref+2,nsoilmx
-                  ith(i,j,isoil)=iceith 
-                enddo
-              endif ! of if (val.lt.layer(nsoilmx))
-            endif ! of if (MONS_Hdn(i,j).lt.14.0)
-          enddo ! do j=1,jjp1
-        enddo ! do i=1,iip1
-        
-! Check:
-!         do i=1,iip1
-!           do j=1,jjp1
-!             do isoil=1,nsoilmx
-!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
-!             enddo
-!           enddo
-!	 enddo
-
-        ! recast ith() into ithfi()
-        CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-        
-	else
-          write(*,*) '       Unknown (misspelled?) option!!!'
-        end if ! of if (trim(modif) .eq. '...') elseif ...
-	
-       enddo ! of do ! infinite loop on liste of changes
-
- 999  continue
-
- 
-c=======================================================================
-c   Correct pressure on the new grid (menu 0)
-c=======================================================================
-
-      if (choix_1.eq.0) then
-        r = 1000.*8.31/mugaz
-
-        do j=1,jjp1
-          do i=1,iip1
-             ps(i,j) = ps(i,j) * 
-     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
-     .                                  (t(i,j,1) * r))
-          end do
-        end do
-  
-c periodicity of surface ps in longitude
-        do j=1,jjp1
-          ps(1,j) = ps(iip1,j)
-        end do
-      end if
-
-c=======================================================================
-c=======================================================================
-
-c=======================================================================
-c    Initialisation de la physique / ecriture de newstartfi :
-c=======================================================================
-
-
-      CALL inifilr 
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-
-c-----------------------------------------------------------------------
-c   Initialisation  pks:
-c-----------------------------------------------------------------------
-
-      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-! Calcul de la temperature potentielle teta
-
-      if (flagiso) then
-          DO l=1,llm
-             DO j=1,jjp1
-                DO i=1,iim
-                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
-                ENDDO
-                teta (iip1,j,l)= teta (1,j,l)
-             ENDDO
-          ENDDO
-      else if (choix_1.eq.0) then
-         DO l=1,llm
-            DO j=1,jjp1
-               DO i=1,iim
-                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
-               ENDDO
-               teta (iip1,j,l)= teta (1,j,l)
-            ENDDO
-         ENDDO
-      endif
-
-C Calcul intermediaire
-c
-      if (choix_1.eq.0) then
-         CALL massdair( p3d, masse  )
-c
-         print *,' ALPHAX ',alphax
-
-         DO  l = 1, llm
-           DO  i    = 1, iim
-             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
-             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
-           ENDDO
-             xpn      = SUM(xppn)/apoln
-             xps      = SUM(xpps)/apols
-           DO i   = 1, iip1
-             masse(   i   ,   1     ,  l )   = xpn
-             masse(   i   ,   jjp1  ,  l )   = xps
-           ENDDO
-         ENDDO
-      endif
-      phis(iip1,:) = phis(1,:)
-
-      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
-     *                tetagdiv, tetagrot , tetatemp  )
-      itau=0
-      if (choix_1.eq.0) then
-         day_ini=int(date)
-         hour_ini=date-int(date)
-      endif
-c
-      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
-
-      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
-     *                phi,w, pbaru,pbarv,day_ini+time )
-c     CALL caldyn
-c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
-c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
-
-      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
-      CALL dynredem1("restart.nc",hour_ini,vcov,ucov,teta,q,
-     .               nqtot,masse,ps)
-C
-C Ecriture etat initial physique
-C
-
-      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
-     .              nqtot,dtphys,real(day_ini),0.0,
-     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nqtot,
-     .              dtphys,hour_ini,
-     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
-
-c=======================================================================
-c	Formats 
-c=======================================================================
-
-   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur parametree llm =',i4//)
-
-      write(*,*) "newstart: All is well that ends well."
-
-      end
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      subroutine load_MONS_data(MONS_Hdn,MONS_d21)
-      implicit none
-      ! routine to load Benedicte Diez MONS dataset, fill in date in southern
-      ! polar region, and interpolate the result onto the GCM grid
-#include"dimensions.h"
-#include"paramet.h"
-#include"datafile.h"
-#include"comgeom.h"
-      ! arguments:
-      real,intent(out) :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
-      real,intent(out) :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
-      ! N.B MONS datasets should be of dimension (iip1,jjp1)
-      ! local variables:
-      character(len=88) :: filename="results_MONS_lat_lon_H_depth.txt"
-      character(len=88) :: txt ! to store some text
-      integer :: ierr,i,j
-      integer,parameter :: nblon=180 ! number of longitudes of MONS datasets
-      integer,parameter :: nblat=90 ! number of latitudes of MONS datasets
-      real :: pi
-      real :: longitudes(nblon) ! MONS dataset longitudes
-      real :: latitudes(nblat)  ! MONS dataset latitudes
-      ! MONS dataset: mass fraction of H2O where H is assumed to be in H2O
-      real :: Hdn(nblon,nblat)
-      real :: d21(nblon,nblat)! MONS dataset "depth" (g/cm2)
-
-      ! Extended MONS dataset (for interp_horiz)
-      real :: Hdnx(nblon+1,nblat)
-      real :: d21x(nblon+1,nblat)
-      real :: lon_bound(nblon+1) ! longitude boundaries
-      real :: lat_bound(nblat-1) ! latitude boundaries
-
-      ! 1. Initializations:
-
-      write(*,*) "Loading MONS data"
-
-      ! Open MONS datafile:
-      open(42,file=trim(datafile)//"/"//trim(filename),
-     &     status="old",iostat=ierr)
-      if (ierr/=0) then
-        write(*,*) "Error in load_MONS_data:"
-        write(*,*) "Failed opening file ",
-     &             trim(datafile)//"/"//trim(filename)
-        write(*,*)'1) You can change the path to the file in '
-        write(*,*)'   file phymars/datafile.h'
-        write(*,*)'2) If necessary ',trim(filename),
-     &                 ' (and other datafiles)'
-        write(*,*)'   can be obtained online at:'
-        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
-        CALL ABORT
-      else ! skip first line of file (dummy read)
-         read(42,*) txt
-      endif
-
-      pi=2.*asin(1.)
-      
-      !2. Load MONS data (on MONS grid)
-      do j=1,nblat
-        do i=1,nblon
-        ! swap latitude index so latitudes go from north pole to south pole:
-          read(42,*) latitudes(nblat-j+1),longitudes(i),
-     &               Hdn(i,nblat-j+1),d21(i,nblat-j+1)
-        ! multiply d21 by 10 to convert from g/cm2 to kg/m2
-          d21(i,nblat-j+1)=d21(i,nblat-j+1)*10.0
-        enddo
-      enddo
-      close(42)
-      
-      ! there is unfortunately no d21 data for latitudes -77 to -90
-      ! so we build some by linear interpolation between values at -75
-      ! and assuming d21=0 at the pole
-      do j=84,90 ! latitudes(84)=-77 ; latitudes(83)=-75
-        do i=1,nblon
-          d21(i,j)=d21(i,83)*((latitudes(j)+90)/15.0)
-        enddo
-      enddo
-
-      ! 3. Build extended MONS dataset & boundaries (for interp_horiz)
-      ! longitude boundaries (in radians):
-      do i=1,nblon
-        ! NB: MONS data is every 2 degrees in longitude
-        lon_bound(i)=(longitudes(i)+1.0)*pi/180.0
-      enddo
-      ! extra 'modulo' value
-      lon_bound(nblon+1)=lon_bound(1)+2.0*pi
-      
-      ! latitude boundaries (in radians):
-      do j=1,nblat-1
-        ! NB: Mons data is every 2 degrees in latitude
-        lat_bound(j)=(latitudes(j)-1.0)*pi/180.0
-      enddo
-      
-      ! MONS datasets:
-      do j=1,nblat
-        Hdnx(1:nblon,j)=Hdn(1:nblon,j)
-        Hdnx(nblon+1,j)=Hdnx(1,j)
-        d21x(1:nblon,j)=d21(1:nblon,j)
-        d21x(nblon+1,j)=d21x(1,j)
-      enddo
-      
-      ! Interpolate onto GCM grid
-      call interp_horiz(Hdnx,MONS_Hdn,nblon,nblat-1,iim,jjm,1,
-     &                  lon_bound,lat_bound,rlonu,rlatv)
-      call interp_horiz(d21x,MONS_d21,nblon,nblat-1,iim,jjm,1,
-     &                  lon_bound,lat_bound,rlonu,rlatv)
-      
-      end subroutine
Index: unk/LMDZ.MARS/libf/phymars/start2archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/start2archive.F	(revision 1402)
+++ 	(revision )
@@ -1,412 +1,0 @@
-c=======================================================================
-      PROGRAM start2archive
-c=======================================================================
-c
-c
-c   Date:    01/1997
-c   ----
-c
-c
-c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
-c   -----    "startfi" a un fichier netcdf unique "start_archive" 
-c
-c  "start_archive" est une banque d'etats initiaux:
-c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
-c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
-c 
-c
-c
-c=======================================================================
-
-      use infotrac, only: iniadvtrac, nqtot, tname
-      use comsoil_h, only: nsoilmx, inertiedat
-      use surfdat_h, only: ini_surfdat_h, qsurf
-      use comsoil_h, only: ini_comsoil_h
-      use comgeomphy, only: initcomgeomphy
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "temps.h"
-#include "ener.h"
-#include "description.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 :: q(:,:,:)   ! champs advectes
-      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
-      REAL pk(ip1jmp1,llm)
-      REAL pkf(ip1jmp1,llm)
-      REAL 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 ------------------------------------
-      REAL tsurf(ngridmx)	! Surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
-      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL tauscaling(ngridmx) ! dust conversion factor
-      REAL q2(ngridmx,llm+1)
-      REAL emis(ngridmx)
-      INTEGER start,length
-      PARAMETER (length = 100)
-      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
-      INTEGER*4 day_ini_fi
-
-c Variable naturelle / grille scalaire
-c ------------------------------------
-      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
-      REAL tsurfS(ip1jmp1)
-      REAL tsoilS(ip1jmp1,nsoilmx)
-      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
-      REAL co2iceS(ip1jmp1)
-      REAL tauscalingS(ip1jmp1)
-      REAL q2S(ip1jmp1,llm+1)
-      REAL,ALLOCATABLE :: qsurfS(:,:)
-      REAL emisS(ip1jmp1)
-
-c Variables intermediaires : vent naturel, mais pas coord scalaire
-c----------------------------------------------------------------
-      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
-
-c Autres  variables
-c -----------------
-      LOGICAL startdrs
-      INTEGER Lmodif
-
-      REAL ptotal, co2icetotal
-      REAL timedyn,timefi !fraction du jour dans start, startfi
-      REAL date
-
-      CHARACTER*2 str2
-      CHARACTER*80 fichier 
-      data  fichier /'startfi'/
-
-      INTEGER ij, l,i,j,isoil,iq
-      character*80      fichnom
-      integer :: ierr,ntime
-      integer :: nq,numvanle
-      character(len=30) :: txt ! to store some text
-
-c Netcdf
-c-------
-      integer varid,dimid,timelen 
-      INTEGER nid,nid1
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .TRUE. )
-      grireg   = .TRUE.
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-c=======================================================================
-c Lecture des donnees
-c=======================================================================
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-
-! allocate arrays:
-      allocate(q(ip1jmp1,llm,nqtot))
-      allocate(qsurfS(ip1jmp1,nqtot))
-      call ini_surfdat_h(ngridmx,nqtot)
-      call ini_comsoil_h(ngridmx)
-      
-
-      fichnom = 'start.nc'
-      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,timedyn)
-
-
-      fichnom = 'startfi.nc'
-      Lmodif=0
-
-      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
-     &      day_ini_fi,timefi,tsurf,tsoil,emis,q2,qsurf,co2ice,
-     &      tauscaling)
-
-       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
-       IF (ierr.NE.NF_NOERR) THEN
-         write(6,*)' Pb d''ouverture du fichier'//fichnom
-        CALL ABORT
-       ENDIF
-                                                
-      ierr = NF_INQ_VARID (nid1, "controle", varid)
-      IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "start2archive: Le champ <controle> est absent"
-       CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
-#else
-      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
-#endif
-       IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "start2archive: Lecture echoue pour <controle>"
-          CALL abort
-       ENDIF
-
-      ierr = NF_CLOSE(nid1)
-
-c-----------------------------------------------------------------------
-c Controle de la synchro
-c-----------------------------------------------------------------------
-!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
-      if ((day_ini_fi.ne.day_ini)) 
-     &  stop ' Probleme de Synchro entre start et startfi !!!'
-
-
-c *****************************************************************
-c    Option : Reinitialisation des dates dans la premieres annees :
-       do while (day_ini.ge.669)
-          day_ini=day_ini-669
-       enddo
-c *****************************************************************
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .FALSE. )
-      call iniconst
-      call inigeom
-      call inifilr
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-
-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-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO ij=1,ip1jmp1
-            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c Variable physique 
-c-----------------------------------------------------------------------
-c
-c tsurf --> tsurfS
-c co2ice --> co2iceS
-c tsoil --> tsoilS
-c emis --> emisS
-c q2 --> q2S
-c qsurf --> qsurfS
-c tauscaling --> tauscalingS
-c
-c-----------------------------------------------------------------------
-
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
-      ! Note: thermal inertia "inertiedat" is in comsoil.h
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
-      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
-      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
-
-c=======================================================================
-c Info pour controler
-c=======================================================================
-
-      ptotal =  0.
-      co2icetotal = 0.
-      DO j=1,jjp1
-         DO i=1,iim
-           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
-           co2icetotal = co2icetotal + 
-     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
-         ENDDO
-      ENDDO
-      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
-      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
-
-c-----------------------------------------------------------------------
-c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
-c-----------------------------------------------------------------------
-
-      tab_cntrl_fi(49) = ptotal
-      tab_cntrl_fi(50) = co2icetotal
-
-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 dynamique (1 a 16) 
-c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
-c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
-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', 
-     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
-         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture de la coordonnee temps (date en jours)
-c-----------------------------------------------------------------------
-
-      date = day_ini + hour_ini
-      ierr= NF_INQ_VARID(nid,"Time",varid)
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-      ntime=timelen+1
-
-      write(*,*) "******************"
-      write(*,*) "ntime",ntime
-      write(*,*) "******************"
-#ifdef NC_DOUBLE
-      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
-#else
-      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
-#endif
-      if (ierr.ne.NF_NOERR) then
-         write(*,*) "time matter ",NF_STRERROR(ierr)
-         stop
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
-c-----------------------------------------------------------------------
-c ATTENTION: q2 a une couche de plus!!!!
-c    Pour creer un fichier netcdf lisible par grads,
-c    On passe donc une des couches de q2 a part
-c    comme une variable 2D (la couche au sol: "q2surf")
-c    Les lmm autres couches sont nommees "q2atm" (3D) 
-c-----------------------------------------------------------------------
-
-      call write_archive(nid,ntime,'co2ice','couche de glace co2',
-     &  'kg/m2',2,co2iceS)
-      call write_archive(nid,ntime,'tauscaling',
-     &  'dust conversion factor',' ',2,tauscalingS)
-      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
-      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
-      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
-      call write_archive(nid,ntime,'temp','temperature','K',3,t)
-      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
-      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
-      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
-     .              q2S)
-      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
-     .              q2S(1,2))
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  q  ( q[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-c       write(str2,'(i2.2)') iq
-c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
-c     .         3,q(1,1,iq))
-        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
-     &         3,q(1,1,iq))
-      end do
-c-----------------------------------------------------------------------
-c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-c       write(str2,'(i2.2)') iq
-c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
-c     $  'kg.m-2',2,qsurfS(1,iq))
-        txt=trim(tname(iq))//"_surf"
-        call write_archive(nid,ntime,txt,'Tracer on surface',
-     &  'kg.m-2',2,qsurfS(1,iq))
-      enddo
-
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  tsoil  ( Tg[1,10] )
-c-----------------------------------------------------------------------
-c "tsoil" Temperature au sol definie dans 10 couches dans le sol
-c   Les 10 couches sont lues comme 10 champs 
-c  nommees Tg[1,10]
-
-c      do isoil=1,nsoilmx
-c       write(str2,'(i2.2)') isoil
-c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
-c     .   'K',2,tsoilS(1,isoil))
-c      enddo
-
-! Write soil temperatures tsoil
-      call write_archive(nid,ntime,'tsoil','Soil temperature',
-     &     'K',-3,tsoilS)
-
-! Write soil thermal inertia
-      call write_archive(nid,ntime,'inertiedat',
-     &     'Soil thermal inertia',
-     &     'J.s-1/2.m-2.K-1',-3,ithS)
-
-! Write (0D) volumetric heat capacity (stored in comsoil.h)
-!      call write_archive(nid,ntime,'volcapa',
-!     &     'Soil volumetric heat capacity',
-!     &     'J.m-3.K-1',0,volcapa)
-! Note: no need to write volcapa, it is stored in "controle" table
-
-      ierr=NF_CLOSE(nid)
-c-----------------------------------------------------------------------
-c Fin 
-c-----------------------------------------------------------------------
-
-      write(*,*) "startarchive: all is well that ends well"
-      
-      end 
Index: unk/LMDZ.MARS/libf/phymars/testphys1d.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/testphys1d.F	(revision 1402)
+++ 	(revision )
@@ -1,830 +1,0 @@
-
-      PROGRAM testphys1d
-! to use  'getin'
-      USE ioipsl_getincom, only: getin
-      use infotrac, only: nqtot, tname
-      use comsoil_h, only: volcapa, layer, mlayer, inertiedat, nsoilmx
-      use comgeomfi_h, only: lati, long, area, sinlat, ini_fillgeom
-      use surfdat_h, only: albedodat, z0_default, emissiv, emisice,
-     &                     albedice, iceradius, dtemisice, z0,
-     &                     zmea, zstd, zsig, zgam, zthe, phisfi,
-     &                     watercaptag
-      use slope_mod, only: theta_sl, psi_sl
-      use control_mod, only: day_step
-      use phyredem, only: physdem0,physdem1
-      use comgeomphy, only: initcomgeomphy
-      use planete_h, only: year_day, periheli, aphelie, peri_day,
-     &                     obliquit, emin_turb, lmixmin
-      use comcstfi_h, only: pi, rad, daysec, omeg, g, mugaz, rcp, r,
-     &                      cpp, dtphys
-      use dimradmars_mod, only: tauscaling,tauvis
-      IMPLICIT NONE
-
-c=======================================================================
-c   subject:
-c   --------
-c   PROGRAM useful to run physical part of the martian GCM in a 1D column
-c       
-c Can be compiled with a command like (e.g. for 25 layers)
-c  "makegcm -p mars -d 25 testphys1d"
-c It requires the files "testphys1d.def" "callphys.def"
-c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
-c      and a file describing the sigma layers (e.g. "z2sig.def")
-c
-c   author: Frederic Hourdin, R.Fournier,F.Forget
-c   -------
-c   
-c   update: 12/06/2003 including chemistry (S. Lebonnois) 
-c                            and water ice (F. Montmessin)
-c 
-c=======================================================================
-
-#include "dimensions.h"
-      integer, parameter :: ngrid = 1 !(2+(jjm-1)*iim - 1/jjm)
-      integer, parameter :: nlayer = llm
-!#include "dimradmars.h"
-!#include "comgeomfi.h"
-!#include "surfdat.h"
-!#include "slope.h"
-!#include "comsoil.h"
-!#include "comdiurn.h"
-#include "callkeys.h"
-!#include "comsaison.h"
-!#include "control.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "comg1d.h"
-#include "logic.h"
-!#include "advtrac.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unitstart      ! unite d'ecriture de "startfi"
-      INTEGER nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day           ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(nlayer)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(nlayer+1) ! intermediate pressure levels (pa)
-      REAL psurf,tsurf(1)      
-      REAL u(nlayer),v(nlayer)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(nlayer)   ! temperature at the middle of the layers
-      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
-      REAL,ALLOCATABLE :: qsurf(:) ! tracer surface budget (e.g. kg.m-2)
-      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
-      REAL co2ice(1)        ! co2ice layer (kg.m-2)
-      REAL emis(1)          ! surface layer
-      REAL q2(nlayer+1)   ! Turbulent Kinetic Energy
-      REAL zlay(nlayer)   ! altitude estimee dans les couches (km)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(nlayer),dv(nlayer),dtemp(nlayer)
-      REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer)
-      REAL dpsurf    
-      REAL,ALLOCATABLE :: dq(:,:)
-      REAL,ALLOCATABLE :: dqdyn(:,:)
-
-c   Various intermediate variables
-      INTEGER thermo
-      REAL zls
-      REAL phi(nlayer),h(nlayer),s(nlayer)
-      REAL pks, ptif, w(nlayer)
-      REAL qtotinit,qtot
-      real,allocatable :: mqtot(:)
-      INTEGER ierr, aslun
-      REAL tmp1(0:nlayer),tmp2(0:nlayer)
-      Logical  tracerdyn
-      integer :: nq=1 ! number of tracers
-      real :: latitude(1), longitude(1)
-
-      character*2 str2
-      character (len=7) :: str7
-      character(len=44) :: txt
-
-c=======================================================================
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-! initialize "serial/parallel" related stuff
-!      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-c ------------------------------------------------------
-c  Prescribed constants to be set here
-c ------------------------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Mars planetary constants
-c     ----------------------------
-      rad=3397200.               ! mars radius (m)  ~3397200 m
-      daysec=88775.              ! length of a sol (s)  ~88775 s
-      omeg=4.*asin(1.)/(daysec)  ! rotation rate (rad.s-1)
-      g=3.72                     ! gravity (m.s-2) ~3.72  
-      mugaz=43.49                ! atmosphere mola mass (g.mol-1) ~43.49
-      rcp=.256793                ! = r/cp  ~0.256793
-      r= 8.314511E+0 *1000.E+0/mugaz
-      cpp= r/rcp
-      year_day = 669             ! lenght of year (sols) ~668.6
-      periheli = 206.66          ! minimum sun-mars distance (Mkm) ~206.66
-      aphelie = 249.22           ! maximum sun-mars distance (Mkm) ~249.22
-      peri_day =  485.           ! perihelion date (sols since N. Spring)
-      obliquit = 25.2            ! Obliquity (deg) ~25.2         
- 
-c     Planetary Boundary Layer and Turbulence parameters 
-c     --------------------------------------------------
-      z0_default =  1.e-2        ! surface roughness (m) ~0.01 
-      emin_turb = 1.e-6          ! minimal turbulent energy ~1.e-8
-      lmixmin = 30               ! mixing length ~100
- 
-c     cap properties and surface emissivities
-c     ----------------------------------------------------
-      emissiv= 0.95              ! Bare ground emissivity ~.95
-      emisice(1)=0.95            ! Northern cap emissivity
-      emisice(2)=0.95            ! Southern cap emisssivity
-      albedice(1)=0.5            ! Northern cap albedo
-      albedice(2)=0.5            ! Southern cap albedo
-      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
-      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
-      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
-      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
-
-
-c ------------------------------------------------------
-c  Loading run parameters from "run.def" file
-c ------------------------------------------------------
-
-
-! check if 'run.def' file is around (otherwise reading parameters
-! from callphys.def via getin() routine won't work.
-      open(99,file='run.def',status='old',form='formatted',
-     &     iostat=ierr)
-      if (ierr.ne.0) then
-        write(*,*) 'Cannot find required file "run.def"'
-        write(*,*) '  (which should contain some input parameters'
-        write(*,*) '   along with the following line:'
-        write(*,*) '   INCLUDEDEF=callphys.def'
-        write(*,*) '   )'
-        write(*,*) ' ... might as well stop here ...'
-        stop
-      else
-        close(99)
-      endif
-
-! check if we are going to run with or without tracers
-      write(*,*) "Run with or without tracer transport ?"
-      tracer=.false. ! default value
-      call getin("tracer",tracer)
-      write(*,*) " tracer = ",tracer
-
-! while we're at it, check if there is a 'traceur.def' file
-! and process it.
-      if (tracer) then
-      ! load tracer names from file 'traceur.def'
-        open(90,file='traceur.def',status='old',form='formatted',
-     &       iostat=ierr)
-        if (ierr.ne.0) then
-          write(*,*) 'Cannot find required file "traceur.def"'
-          write(*,*) ' If you want to run with tracers, I need it'
-          write(*,*) ' ... might as well stop here ...'
-          stop
-        else
-          write(*,*) "testphys1d: Reading file traceur.def"
-          ! read number of tracers:
-          read(90,*,iostat=ierr) nq
-          nqtot=nq ! set value of nqtot (in infotrac module) as nq
-          if (ierr.ne.0) then
-            write(*,*) "testphys1d: error reading number of tracers"
-            write(*,*) "   (first line of traceur.def) "
-            stop
-          endif
-        endif
-        ! allocate arrays:
-        allocate(tname(nq))
-        allocate(q(nlayer,nq))
-        allocate(qsurf(nq))
-        allocate(dq(nlayer,nq))
-        allocate(dqdyn(nlayer,nq))
-        allocate(mqtot(nq))
-        
-        ! read tracer names from file traceur.def
-        do iq=1,nq
-          read(90,*,iostat=ierr) tname(iq)
-          if (ierr.ne.0) then
-            write(*,*) 'testphys1d: error reading tracer names...'
-            stop
-          endif
-        enddo
-        close(90)
-
-        ! initialize tracers here:
-        write(*,*) "testphys1d: initializing tracers"
-        q(:,:)=0 ! default, set everything to zero
-        qsurf(:)=0
-        ! "smarter" initialization of some tracers
-        ! (get values from "profile_*" files, if these are available)
-        do iq=1,nq
-          txt=""
-          write(txt,"(a)") tname(iq)
-          write(*,*)"  tracer:",trim(txt)
-          ! CO2
-          if (txt.eq."co2") then
-            q(:,iq)=0.95   ! kg /kg of atmosphere
-            qsurf(iq)=0. ! kg/m2 (not used for CO2)
-            ! even better, look for a "profile_co2" input file
-            open(91,file='profile_co2',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            endif
-            close(91)
-          endif ! of if (txt.eq."co2")
-          ! Allow for an initial profile of argon
-          ! Can also be used to introduce a decaying tracer
-          ! in the 1D (TBD) to study thermals
-          if (txt.eq."ar") then
-            !look for a "profile_ar" input file
-            open(91,file='profile_ar',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ar file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ar")
-
-          ! WATER VAPOUR
-          if (txt.eq."h2o_vap") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_vap',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_vap file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! WATER ICE
-          if (txt.eq."h2o_ice") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_ice',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_ice file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! DUST
-          !if (txt(1:4).eq."dust") then
-          !  q(:,iq)=0.4    ! kg/kg of atmosphere
-          !  qsurf(iq)=100 ! kg/m2
-          !endif
-          ! DUST MMR
-          if (txt.eq."dust_mass") then
-            !look for a "profile_dust_mass" input file
-            open(91,file='profile_dust_mass',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_mass file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_mass")
-          ! DUST NUMBER
-          if (txt.eq."dust_number") then
-            !look for a "profile_dust_number" input file
-            open(91,file='profile_dust_number',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_number file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_number")
-          ! NB: some more initializations (chemistry) is done later
-          ! CCN MASS
-          if (txt.eq."ccn_mass") then
-            !look for a "profile_ccn_mass" input file
-            open(91,file='profile_ccn_mass',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ccn_mass file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ccn_mass")
-          ! CCN NUMBER
-          if (txt.eq."ccn_number") then
-            !look for a "profile_ccn_number" input file
-            open(91,file='profile_ccn_number',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ccn_number file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ccn_number")
-        enddo ! of do iq=1,nq
-
-      else
-      ! we still need to set (dummy) tracer number and names for physdem1
-        nq=1
-        nqtot=nq ! set value of nqtot (in infotrac module) as nq
-        ! allocate arrays:
-        allocate(tname(nq))
-        allocate(q(nlayer,nq))
-        allocate(qsurf(nq))
-        allocate(dq(nlayer,nq))
-        allocate(dqdyn(nlayer,nq))
-        allocate(mqtot(nq))
-        do iq=1,nq
-          write(str7,'(a1,i2.2)')'t',iq
-          tname(iq)=str7
-        enddo
-      ! and just to be clean, also initialize tracers to zero for physdem1
-        q(:,:)=0 
-        qsurf(:)=0      
-      endif ! of if (tracer)
-      
-      !write(*,*) "testphys1d q", q(1,:)
-      !write(*,*) "testphys1d qsurf", qsurf
-
-c  Date and local time at beginning of run
-c  ---------------------------------------
-c    Date (in sols since spring solstice) at beginning of run
-      day0 = 0 ! default value for day0
-      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
-      call getin("day0",day0)
-      day=float(day0)
-      write(*,*) " day0 = ",day0
-c  Local time at beginning of run 
-      time=0 ! default value for time
-      write(*,*)'Initial local time (in hours, between 0 and 24)?'
-      call getin("time",time)
-      write(*,*)" time = ",time
-      time=time/24.E+0 ! convert time (hours) to fraction of sol
-
-c  Discretization (Definition of grid and time steps)
-c  --------------
-c
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-
-      day_step=48 ! default value for day_step
-      PRINT *,'Number of time steps per sol ?'
-      call getin("day_step",day_step)
-      write(*,*) " day_step = ",day_step
-
-      ndt=10 ! default value for ndt
-      PRINT *,'Number of sols to run ?'
-      call getin("ndt",ndt)
-      write(*,*) " ndt = ",ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-
-c Imposed surface pressure
-c ------------------------------------
-c
-      psurf=610. ! default value for psurf
-      PRINT *,'Surface pressure (Pa) ?'
-      call getin("psurf",psurf)
-      write(*,*) " psurf = ",psurf
-c Reference pressures
-      pa=20.   ! transition pressure (for hybrid coord.)
-      preff=610.      ! reference surface pressure
- 
-c Aerosol properties
-c --------------------------------
-      tauvis=0.2 ! default value for tauvis (dust opacity)
-      write(*,'("Reference dust opacity at ",f4.0," Pa ?")')odpref
-      call getin("tauvis",tauvis)
-      write(*,*) " tauvis = ",tauvis
-
-c Orbital parameters
-c ------------------
-      print *,'Min. distance Sun-Mars (Mkm)?'
-      call getin("periheli",periheli)
-      write(*,*) " periheli = ",periheli
-
-      print *,'Max. distance Sun-Mars (Mkm)?'
-      call getin("aphelie",aphelie)
-      write(*,*) " aphelie = ",aphelie
-
-      print *,'Day of perihelion?'
-      call getin("periday",peri_day)
-      write(*,*) " periday = ",peri_day
-
-      print *,'Obliquity?'
-      call getin("obliquit",obliquit)
-      write(*,*) " obliquit = ",obliquit
- 
-c  latitude/longitude
-c  ------------------
-      latitude(1)=0 ! default value for latitude
-      PRINT *,'latitude (in degrees) ?'
-      call getin("latitude",latitude(1))
-      write(*,*) " latitude = ",latitude
-      latitude=latitude*pi/180.E+0
-      longitude=0.E+0
-      longitude=longitude*pi/180.E+0
-
-!  some initializations (some of which have already been
-!  done above!) and loads parameters set in callphys.def
-!  and allocates some arrays 
-!Mars possible matter with dtphys in input and include!!!
-      call phys_state_var_init(1,llm,nq,
-     .          daysec,dtphys,rad,g,r,cpp)
-      call ini_fillgeom(1,latitude,longitude,(/1.0/))
-      call conf_phys(1,llm,nq)
-
-
-c  Initialize albedo / soil thermal inertia
-c  ----------------------------------------
-c
-      albedodat(1)=0.2 ! default value for albedodat
-      PRINT *,'Albedo of bare ground ?'
-      call getin("albedo",albedodat(1))
-      write(*,*) " albedo = ",albedodat(1)
-
-      inertiedat(1,1)=400 ! default value for inertiedat
-      PRINT *,'Soil thermal inertia (SI) ?'
-      call getin("inertia",inertiedat(1,1))
-      write(*,*) " inertia = ",inertiedat(1,1)
-
-      z0(1)=z0_default ! default value for roughness
-      write(*,*) 'Surface roughness length z0 (m)?'
-      call getin("z0",z0(1))
-      write(*,*) " z0 = ",z0(1)
-
-! Initialize local slope parameters (only matters if "callslope"
-! is .true. in callphys.def)
-      ! slope inclination angle (deg) 0: horizontal, 90: vertical
-      theta_sl(1)=0.0 ! default: no inclination
-      call getin("slope_inclination",theta_sl(1))
-      ! slope orientation (deg)
-      ! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward
-      psi_sl(1)=0.0 ! default value
-      call getin("slope_orientation",psi_sl(1))
-      
-c
-c  for the gravity wave scheme
-c  ---------------------------------
-c
-      zmea(1)=0.E+0
-      zstd(1)=0.E+0
-      zsig(1)=0.E+0
-      zgam(1)=0.E+0
-      zthe(1)=0.E+0
-
-
-c   Specific initializations for "physiq"
-c   -------------------------------------
-c   mesh surface (not a very usefull quantity in 1D)
-      area(1)=1.E+0
-
-c   surface geopotential is not used (or useful) since in 1D
-c   everything is controled by surface pressure
-      phisfi(1)=0.E+0
-
-c   Initialization to take into account prescribed winds
-c   ------------------------------------------------------
-      ptif=2.E+0*omeg*sinlat(1)
- 
-c    geostrophic wind
-      gru=10. ! default value for gru
-      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
-      call getin("u",gru)
-      write(*,*) " u = ",gru
-      grv=0. !default value for grv
-      PRINT *,'meridional northward component of the geostrophic',
-     &' wind (m/s) ?'
-      call getin("v",grv)
-      write(*,*) " v = ",grv
-
-c     Initialize winds  for first time step
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c     Initialize turbulente kinetic energy
-      DO ilevel=1,nlevel
-         q2(ilevel)=0.E+0
-      ENDDO
-
-c  CO2 ice on the surface
-c  -------------------
-      co2ice(1)=0.E+0 ! default value for co2ice
-      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
-      call getin("co2ice",co2ice)
-      write(*,*) " co2ice = ",co2ice
-
-c
-c  emissivity
-c  ----------
-      emis=emissiv
-      IF (co2ice(1).eq.1.E+0) THEN
-         emis=emisice(1) ! northern hemisphere
-         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
-      ENDIF
-
- 
-
-c  Compute pressures and altitudes of atmospheric levels 
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates
-c    """"""""""""""""""""
-      hybrid=.true.
-      PRINT *,'Hybrid coordinates ?'
-      call getin("hybrid",hybrid)
-      write(*,*) " hybrid = ", hybrid
-
-      CALL  disvert
-
-      DO ilevel=1,nlevel
-        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
-     &   /g
-      ENDDO
-
-
-c  Initialize temperature profile
-c  --------------------------------------
-      pks=psurf**rcp
-
-c altitude in km in profile: divide zlay by 1000
-      tmp1(0)=0.E+0
-      DO ilayer=1,nlayer
-        tmp1(ilayer)=zlay(ilayer)/1000.E+0
-      ENDDO
-
-      call profile(nlayer+1,tmp1,tmp2)
-
-      tsurf=tmp2(0)
-      DO ilayer=1,nlayer
-        temp(ilayer)=tmp2(ilayer)
-      ENDDO
-      
-
-
-! Initialize soil properties and temperature
-! ------------------------------------------
-      volcapa=1.e6 ! volumetric heat capacity
-      DO isoil=1,nsoil
-         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
-         tsoil(isoil)=tsurf(1)  ! soil temperature
-      ENDDO
-
-! Initialize depths
-! -----------------
-      do isoil=0,nsoil-1
-        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
-      enddo
-      do isoil=1,nsoil
-        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
-      enddo
-
-c    Initialize traceurs
-c    ---------------------------
-
-      if (photochem.or.callthermos) then
-         write(*,*) 'Initializing chemical species'
-         ! thermo=0: initialize over all atmospheric layers
-         thermo=0
-         call inichim_newstart(q,psurf,sig,nq,lati,long,area,
-     $   thermo,qsurf)
-      endif
-
-c Check if the surface is a water ice reservoir 
-c --------------------------------------------------
-      watercaptag(1)=.false. ! Default: no water ice reservoir
-      print *,'Water ice cap on ground ?'
-      call getin("watercaptag",watercaptag)
-      write(*,*) " watercaptag = ",watercaptag
-      
-
-c    Initialization for GRADS outputs in "g1d.dat" and "g1d.ctl"
-c    ----------------------------------------------------------------
-c    (output done in "writeg1d", typically called by "physiq.F")
-
-        g1d_nlayer=nlayer
-        g1d_nomfich='g1d.dat'
-        g1d_unitfich=40
-        g1d_nomctl='g1d.ctl'
-        g1d_unitctl=41
-        g1d_premier=.true.
-        g2d_premier=.true.
-
-c  Write a "startfi" file
-c  --------------------
-c  This file will be read during the first call to "physiq".
-c  It is needed to transfert physics variables to "physiq"...
-
-      call physdem0("startfi.nc",long,lati,nsoilmx,ngrid,llm,nq,
-     .              dtphys,float(day0),time,area,
-     .              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("startfi.nc",nsoilmx,ngrid,llm,nq,
-     .              dtphys,time,
-     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
-
-c=======================================================================
-c  1D MODEL TIME STEPPING LOOP
-c=======================================================================
-c
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-c        IF (idt.eq.ndt) lastcall=.true.
-        IF (idt.eq.ndt-day_step-1) then       !test
-         lastcall=.true.
-         call solarlong(day*1.0,zls)
-         write(103,*) 'Ls=',zls*180./pi
-         write(103,*) 'Lat=', lati(1)*180./pi
-         write(103,*) 'Tau=', tauvis/odpref*psurf
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(104,*) 'Ls=',zls*180./pi
-         write(104,*) 'Lat=', lati(1)
-         write(104,*) 'Tau=', tauvis/odpref*psurf
-         write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c     compute geopotential
-c     ~~~~~~~~~~~~~~~~~~~~~
-      DO ilayer=1,nlayer
-        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
-      ENDDO
-      phi(1)=pks*h(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
-     &                  *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       call physics
-c       --------------------
-!      write(*,*) "testphys1d avant q", q(1,:)
-      CALL physiq (1,llm,nq,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,phi,
-     ,     u, v,temp, q,  
-     ,     w,
-C - outputs
-     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
-!      write(*,*) "testphys1d apres q", q(1,:)
-
-
-c       wind increment : specific for 1D
-c       --------------------------------
- 
-c       The physics compute the tendencies on u and v,
-c       here we just add Coriolos effect
-c
-c       DO ilayer=1,nlayer
-c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
-c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
-c       ENDDO
-
-c       For some tests : No coriolis force at equator
-c       if(lati(1).eq.0.) then
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c       end if
-c      
-c
-c       Compute time for next time step
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       compute winds and temperature for next time step
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       compute pressure for next time step 
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! surface pressure change
-           DO ilevel=1,nlevel
-             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-!       increment tracers
-        DO iq = 1, nq
-          DO ilayer=1,nlayer
-             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
-          ENDDO
-        ENDDO
-
-      ENDDO   ! of idt=1,ndt ! end of time stepping loop
-
-c    ========================================================
-c    OUTPUTS
-c    ========================================================
-
-c    finalize and close grads files "g1d.dat" and "g1d.ctl"
-
-c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
-        CALL endg1d(1,nlayer,zlay/1000.,ndt)
-
-      write(*,*) "testphys1d: Everything is cool."
-
-      END
- 
-c***********************************************************************
-c***********************************************************************
-c     Dummy subroutines used only in 3D, but required to
-c     compile testphys1d (to cleanly use writediagfi)
-
-      subroutine gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-
-      IMPLICIT NONE
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-      
-      if (ngrid.ne.1) then
-        write(*,*) "gr_fi_dyn error: in 1D ngrid should be 1!!!"
-        stop
-      endif
-      
-      pdyn(1,1,1:nfield)=pfi(1,1:nfield)
-      
-      end
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d/disvert.F"
-#include "../dyn3d/abort_gcm.F"
Index: unk/LMDZ.MARS/libf/phymars/write_archive.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/write_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,252 +1,0 @@
-c=======================================================================
-      subroutine write_archive(nid,ntime,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 comsoil_h, only: nsoilmx
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-!#include "control.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "description.h"
-#include "temps.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c	Declarations   
-c-----------------------------------------------------------------------
-
-c Arguments:
-
-      INTEGER nid
-      integer ntime ! time index
-      integer 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
-c-----------------------------------------------------------------------
-c      Ecriture du champs dans le fichier            (3 cas)      
-c-----------------------------------------------------------------------
-
-! For an atmospheric 3D Variable
-!--------------------------------
-        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,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
-              ierr= NF_INQ_DIMID(nid,"altitude",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
-
-! mars s'arranger pour qu'il n'y ai plus besoin de ca
-
-c          do l=1,llm
-c             do j=1,jjp1
-c                do i=1,iip1
-c                   pxbis(i,j,l)=px(i,j,llm-l+1)
-c                enddo
-c             enddo
-c          enddo
-           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
-
-
-! For a subterranean 3D Variable
-!-------------------------------
-
-        else if (dim.eq.-3) then
-	! get variables' ID, if it exists
-	ierr=NF_INQ_VARID(nid,nom,varid)
-	
-	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
-	  ! build related coordinates
-	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
-	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
-	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
-	  if (ierr.ne.NF_NOERR) then
-	   write(*,*)"write_archive: dimension <subsurface_layers>",
-     &               " is missing !!!"
-	   call abort
-	  endif
-          ierr=NF_INQ_DIMID(nid,"Time",id(4))
-	  
-	  ! define the variable
-	  write(*,*)"====================="
-	  write(*,*)"defining ",nom
-	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
-	  
-	 endif
-
-        ! build cedges and corners
-        corner(1)=1
-        corner(2)=1
-        corner(3)=1
-        corner(4)=ntime
-
-        edges(1)=iip1
-        edges(2)=jjp1
-        edges(3)=nsoilmx
-        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
-
-
-! For a surface 2D Variable
-!--------------------------
-
-        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,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",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,"Time",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
-
-        else
-	  write(*,*) "write_archive: dim=",dim," ?!?"
-	  call abort
-        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
-
-      return
-      end
-
Index: unk/LMDZ.MARS/libf/phymars/xvik.F
===================================================================
--- /trunk/LMDZ.MARS/libf/phymars/xvik.F	(revision 1402)
+++ 	(revision )
@@ -1,546 +1,0 @@
-      PROGRAM xvik
-      IMPLICIT NONE
-c=======================================================================
-c
-c  Pression au site Viking
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-!#include "control.h"
-#include "ener.h"
-#include "description.h"
-#include "netcdf.inc"      
-
-
-      INTEGER itau,nbpas,nbpasmx
-      PARAMETER(nbpasmx=1000000)
-      REAL temps(nbpasmx)
-      INTEGER unitlec
-      INTEGER i,j,l,jj
-      REAL constR
-
-c   Declarations NCDF:
-c   -----------------
-      CHARACTER*100  varname
-      INTEGER ierr,nid,nvarid,dimid
-      LOGICAL nc
-      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
-      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
-
-c   declarations pour les points viking:
-c   ------------------------------------
-      INTEGER ivik(2),jvik(2),ifile(2),iv
-      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
-      REAL unanj
-
-c   variables meteo:
-c   ----------------
-      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
-      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
-      REAL co2ice(iip1,jjp1), captotN,captotS
-      real t7(iip1,jjp1) ! temperature in 7th atmospheric layer
-
-      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
-
-      LOGICAL firstcal,lcal,latcal,lvent,day_ls
-      INTEGER*4 day0
-
-      REAL ziceco2(iip1,jjp1)
-      REAL day,zt,sollong,sol,dayw
-      REAL airtot1,gh
-
-      INTEGER ii,iyear,kyear
-
-      CHARACTER*2 chr2
-
-       
-c   declarations de l'interface avec mywrite:
-c   -----------------------------------------
-
-      CHARACTER file*80
-      CHARACTER pathchmp*80,pathsor*80,nomfich*80
-
-c   externe:
-c   --------
-
-      EXTERNAL iniconst,inigeom,covcont,mywrite
-      EXTERNAL inifilr,exner,pbar
-      EXTERNAL solarlong,coordij,moy2
-      EXTERNAL SSUM
-      REAL SSUM
-      EXTERNAL lnblnk
-      INTEGER lnblnk
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      unanj=667.9
-      print*,'WARNING!!!',unanj,'Jours/an'
-      nc=.true.
-      lcal=.true.
-      latcal=.true.
-      lvent=.false.
-      day_ls=.true.
-
-c lecture du fichier xvik.def
-
-      phivik(1)=-3627
-      phivik(2)=-4505
-
-
-
-      OPEN(99,file='xvik.def',form='formatted')
-
-      READ(99,*) 
-      READ(99,*,iostat=ierr) phivik
-      IF(ierr.NE.0) GOTO 105
-
-      READ(99,*,END=105)
-      READ(99,'(a)',END=105) pathchmp
-      READ(99,*,END=105)
-      READ(99,'(a)',END=105) pathsor
-      READ(99,*,END=105)
-c     READ(99,'(l1)',END=105) day_ls
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) lcal
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) lvent
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) latcal
- 
- 105  CONTINUE
-      CLOSE(99)
-      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
-      DO iv=1,2
-         phivik(iv)=phivik(iv)*3.73
-      END DO
-
-      write(*,*) ' pathchmp:',trim(pathchmp)
-      write(*,*) ' pathsor:',trim(pathsor)
-      
-c-----------------------------------------------------------------------
-c-----------------------------------------------------------------------
-c   ouverture des fichiers xgraph:
-c   ------------------------------
-
-      ifile(1)=12
-      ifile(2)=13
-      kyear=-1
-c      OPEN(77,file='xlongday',form='formatted')
-
-      unitlec=11
-c
-      PRINT*,'entrer le nom du fichier NC'
-      READ(5,'(a)') nomfich
-
-      PRINT *,'nomfich : ',nomfich
-
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-c   grande boucle sur les fichiers histoire:
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      firstcal=.true.
-      DO WHILE(lnblnk(nomfich).GT.0.AND.lnblnk(nomfich).LT.50)
-      PRINT *,'>>>  nomfich : ',trim(nomfich)
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      file=pathchmp(1:lnblnk(pathchmp))//'/'//
-     s     nomfich(1:lnblnk(nomfich))
-      PRINT*,'file.nc: ', file(1:lnblnk(file))//'.nc'
-      PRINT*,'timestep ',dtvr
-
-      IF(nc) THEN
-      ierr= NF_OPEN(file(1:lnblnk(file))//'.nc',NF_NOWRITE,nid)        
-      ELSE
-         PRINT*,'Ouverture binaire ',file
-         OPEN(unitlec,file=file,status='old',form='unformatted',
-     .   iostat=ierr)
-      ENDIF
-
-c----------------------------------------------------------------------
-c   initialisation de la physique:
-c   ------------------------------
-
-      CALL readhead_NC(file(1:lnblnk(file))//'.nc',day0,phis,constR)
-
-      WRITE (*,*) 'day0 = ' , day0
-
-      CALL iniconst
-      CALL inigeom
-      CALL inifilr
-
-
-c   Lecture temps :
-
-      ierr= NF_INQ_DIMID (nid,"Time",dimid)
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'xvik: Le champ <Time> est absent'
-          CALL abort
-        ENDIF
-
-      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
-
-      ierr = NF_INQ_VARID (nid, "Time", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
-#endif
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'xvik: Lecture echouee pour <Time>'
-          CALL abort
-        ENDIF
-
-        PRINT*,'temps',(temps(itau),itau=1,10)
-              
-c-----------------------------------------------------------------------
-c   coordonnees des point Viking:
-c   -----------------------------
-
-      latvik(1)=22.27*pi/180.
-      lonvik(1)=-47.9*pi/180.
-      latvik(2)=47.67*pi/180.
-      lonvik(2)=(360.-225.71)*pi/180.
-
-c   ponderations pour les 4 points autour de Viking
-      DO iv=1,2
-         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
-         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
-            ivik(iv)=ivik(iv)-1
-         ENDIF
-         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
-            jvik(iv)=jvik(iv)-1
-         ENDIF
-         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
-     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
-         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
-     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
-         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
-         zw(1,0,iv)=zalpha*(1.-zbeta)
-         zw(0,1,iv)=(1.-zalpha)*zbeta
-         zw(1,1,iv)=zalpha*zbeta
-      ENDDO
-
-c   altitude reelle et modele aux points Viking
-      DO iv=1,2
-         phisim(iv)=0.
-         DO jj=0,1
-            j=jvik(iv)+jj
-            DO ii=0,1
-               i=ivik(iv)+ii
-               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
-            ENDDO
-         ENDDO
-      ENDDO
-      PRINT*,'relief aux points Viking pour les sorties:',phivik
-
-c----------------------------------------------------------------------
-c   lectures des etats:
-c   -------------------
-
-       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
-
-c======================================================================
-c   debut de la boucle sur les etats dans un fichier histoire:
-c======================================================================
-       count_ps=(/iip1,jjp1,1/)
-       count_co2ice=(/iip1,jjp1,1/)
-       count_temp=(/iip1,jjp1,llm,1/)
-       
-       DO itau=1,nbpas
-
-       start_ps=(/1,1,itau/)
-       start_co2ice=(/1,1,itau/)
-       start_temp=(/1,1,1,itau/)
-c   lecture drs des champs:
-c   -----------------------
-c         varname='u'
-c         ierr=drsread (unitlec,varname,unat,itau)
-c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
-c         varname='v'
-c         ierr=drsread (unitlec,varname,vnat,itau)
-c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
-
-ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "ps", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <ps>'
-            CALL abort
-          ENDIF
-          
-          PRINT*,'ps',ps(iip1/2,jjp1/2)
-
-ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "temp", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
-#else
-          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <temp>'
-            ! Ehouarn: proceed anyways
-            ! CALL abort
-            write(*,*)'--> Setting temperature to zero !!!'
-            t(1:iip1,1:jjp1,1:llm)=0.0
-            write(*,*)'--> looking for temp7 (temp in 7th layer)'
-            ierr=NF_INQ_VARID(nid,"temp7", nvarid)
-            if (ierr.eq.NF_NOERR) then
-            write(*,*) "    OK, found temp7 variable"
-#ifdef NC_DOUBLE
-            ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start_ps,count_ps,t7)
-#else
-            ierr=NF_GET_VARA_REAL(nid,nvarid,start_ps,count_ps,t7)
-#endif
-              if (ierr.ne.NF_NOERR) then
-                write(*,*)'xvik: failed loading temp7 !'
-                stop
-              endif
-            else ! no 'temp7' variable
-              write(*,*)'  No temp7 variable either !'
-              write(*,*)'  Will have to to without ...'
-              t7(1:iip1,1:jjp1)=0.0
-            endif
-          ELSE ! t() was successfully loaded, copy 7th layer to t7()
-            t7(1:iip1,1:jjp1)=t(1:iip1,1:jjp1,7)
-          ENDIF
-
-c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
-
-ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
-     &    count_co2ice,  co2ice)
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
-     &    count_co2ice, co2ice)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
-            CALL abort
-          ENDIF
-
-
-c Gestion du temps
-c ----------------
-          day=temps(itau)
-          PRINT*,'day ',day
-          CALL solarlong(day+day0,sollong)
-          sol=day+day0+461.
-          iyear=sol/unanj
-          WRITE (*,*) 'iyear',iyear
-          sol=sol-iyear*unanj
-c
-c Ouverture / fermeture des fichiers
-c ----------------------------------
-          IF (iyear.NE.kyear) THEN
-             WRITE(chr2(1:1),'(i1)') iyear+1
-             WRITE (*,*) 'iyear bis',iyear
-             WRITE (*,*) 'chr2'
-             WRITE (*,*)  chr2
-             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
-             kyear=iyear
-             DO ii=1,2
-                CLOSE(10+ifile(ii))
-                CLOSE(2+ifile(ii))
-                CLOSE(4+ifile(ii))
-                CLOSE(6+ifile(ii))
-                CLOSE(8+ifile(ii))
-                CLOSE(16+ifile(ii))
-                CLOSE(12+ifile(ii))
-                CLOSE(14+ifile(ii))
-                CLOSE(97)
-                CLOSE(98)
-             ENDDO
-             CLOSE(5+ifile(1))
-             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
-             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
-c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
-c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
-c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
-c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
-             IF(lcal) THEN
-c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
-c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
-c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
-             ENDIF
-                         IF(latcal) THEN
-c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
-c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
-                         ENDIF
-             IF(lvent) THEN
-c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
-c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
-c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
-c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
-             ENDIF
-             OPEN(97,file='xprestot'//chr2,form='formatted')
-c            OPEN(98,file='xlat37_'//chr2,form='formatted')
-           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
-          ENDIF
- 
-
-          sollong=sollong*180./pi
-          IF(day_ls) THEN
-             dayw=sol
-             write(*,*) 'dayw', dayw
-          ELSE
-             dayw=sollong
-          ENDIF
-
-c Calcul de la moyenne planetaire
-c -------------------------------
-          pstot=0.
-          captotS=0.
-          captotN=0.
-          DO j=1,jjp1
-             DO i=1,iim
-                pstot=pstot+aire(i,j)*ps(i,j)
-             ENDDO
-          ENDDO
- 
-              DO j=1,jjp1/2
-                 DO i=1,iim
-                    captotN = captotN  +aire(i,j)*co2ice(i,j)
-                 ENDDO
-              ENDDO
-              DO j=jjp1/2+1, jjp1
-                 DO i=1,iim
-                    captotS = captotS  +aire(i,j)*co2ice(i,j)
-                 ENDDO
-              ENDDO
-              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
-     &       , captotN*g*airtot1, captotS*g*airtot1          
-
-          IF(.NOT.firstcal) THEN
-         WRITE(98,'(f5.1,16f7.3)')
-     s    dayw,(ps(i,37),i=1,iim,4)
-
-c boucle sur les sites vikings:
-c ----------------------------
-
-          DO iv=1,2
-
-c interpolation de la temperature dans la 7eme couche, de la pression
-c de surface et des vents aux points viking.
-
-             zp1=0.
-             zp2=0.
-             zp2_sm=0.
-             zt=0.
-             zu=0.
-             zv=0.
-             DO jj=0,1
-                j=jvik(iv)+jj
-                DO ii=0,1
-                   i=ivik(iv)+ii
-!                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
-                   zt=zt+zw(ii,jj,iv)*t7(i,j)
-!                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
-                   zp1=zp1+zw(ii,jj,iv)*log(ps(i,j)) ! interpolate in log(P)
-                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
-                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
-                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
-                ENDDO
-             ENDDO
-             zp1=exp(zp1) ! because of the bilinear interpolation in log(P)
- 
-c               pression au sol extrapolee a partir de la temp. 7eme couche
-           WRITE (*,*) 'constR ',constR 
-           WRITE (*,*) 'zt ',zt
-             gh=constR*zt
-             if (gh.eq.0) then ! if we don't have temperature values
-               ! assume a scale height of 10km
-               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/(3.73*1.e4))
-             else
-               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
-             endif
-           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
-           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
-!           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
-           WRITE(ifile(iv)+10,'(3e15.5)') dayw,zp2,zp1
-           
-c   sorties eventuelles de vent
-             IF(lvent) THEN
-                WRITE(ifile(iv)+16,'(2e15.5)')
-     s          dayw,zu
-                WRITE(ifile(iv)+12,'(2e15.5)')
-     s          dayw,zv
-             ENDIF
-          ENDDO
-c         IF (lcal) THEN
-c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
-c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
-c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
-c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
-c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
-c         ENDIF
-c            IF(latcal) THEN
-c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
-c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
-c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
-c            ENDIF
-         ENDIF
-         firstcal=.false.
-
-c======================================================================
-c   Fin de la boucle sur les etats du fichier histoire:
-c======================================================================
-      ENDDO
-
-      ierr= NF_CLOSE(nid)
-
-      PRINT*,'Fin du fichier',nomfich
-      print*,'Entrer un nouveau fichier ou return pour finir'
-      READ(5,'(a)',err=9999) nomfich
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-c   Fin de la boucle sur les fichiers histoire:
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      ENDDO
-
-      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
-      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
-      DO iv=1,2
-         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
-         WRITE(6,7777)
-     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
-         print*
-         DO j=jvik(iv)-1,jvik(iv)+2
-            WRITE(6,'(f8.1,10x,5f7.1)')
-     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
-         ENDDO
-         print*
-         print*,'zw'
-         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
-         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
-      ENDDO
-      PRINT*,'R=',r
- 9999  PRINT*,'Fin '
-
-7777  FORMAT ('latitude/longitude',4f7.1)
-      END
Index: /trunk/LMDZ.MARS/makegcm_g95
===================================================================
--- /trunk/LMDZ.MARS/makegcm_g95	(revision 1402)
+++ /trunk/LMDZ.MARS/makegcm_g95	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=mars
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -14,25 +14,28 @@
 set dyntype="dyn"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
 ########################################################################
 
-##### If you want you can set environment variables here (instead of
-#####  relying on the C-shell environment variables)
-## default LMDGCM to where makegcm script is located:
-#set scriptdir=`dirname $0`
-#setenv LMDGCM `readlink -f $scriptdir`
-## You may set LIBOGCM to something else; otherwise we default to:
-#setenv LIBOGCM $LMDGCM/libo
-### NetCDF Libraries: what follows is OK for LMD 32 and 64bit Linux Machines
-##if ( `uname -m` == "x86_64" ) then
-### 64 bit machines
-#  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
-#  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
-##else
-##  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_g95/lib
-##  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_g95/include
-##endif
-#####
+#### If you want you can set environment variables here (instead of
+####  relying on the C-shell environment variables)
+# default LMDGCM to where makegcm script is located:
+set scriptdir=`dirname $0`
+setenv LMDGCM `readlink -f $scriptdir`
+# You may set LIBOGCM to something else; otherwise we default to:
+setenv LIBOGCM $LMDGCM/libo
+## NetCDF Libraries: what follows is OK for LMD 32 and 64bit Linux Machines
+#if ( `uname -m` == "x86_64" ) then
+# 64 bit machines
+  setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_g95/lib
+  setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_g95/include
+#else
+#  setenv NCDFLIB /donnees/emlmd/netcdf-4.0.1_g95/lib
+#  setenv NCDFINC /donnees/emlmd/netcdf-4.0.1_g95/include
+#endif
+####
 
 setenv localdir "`pwd`"
@@ -183,9 +186,7 @@
 # Ehouarn 'g95' compiler
    set optim="-O3 -fstatic -funroll-loops "
-   set optim90=" -O3 -fstatic -funroll-loops "
-   set optimtru90=" -O3 -fstatic -funroll-loops "
-#   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -Wl,-Bstatic "
-# Ehouarn: there is no /usr/local/pgi/linux86/lib, but it doesn't matter
-#          also changed -Wl,-Bstatic to -Bstatic
+   set optim90="-O3 -fstatic -funroll-loops "
+   set optimtru90="-O3 -fstatic -funroll-loops "
+#
    set opt_link=" -L$NCDFLIB -lnetcdf "
    set mod_loc_dir=$localdir
@@ -217,5 +218,5 @@
 endif
 
-# Ehouarn: add 'g95' string to pathname
+# Ehouarn: add 'g9fortran' string to pathname
 set nomlib=${machine}_g95
 
@@ -405,6 +406,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs aerono$physique phy$physique"
+   set include="$include "'-I$(LIBF)/aerono'"$physique"' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 # choix du nombre de traceur par defaut si il n'a pas ete choisi,
@@ -488,10 +493,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -532,5 +542,4 @@
 cat $libf/grid/dimensions.h
 
-#
 cd $LMDGCM
 # set path to objects directory
@@ -553,5 +562,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -593,6 +607,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -636,9 +655,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "On recree le makefile"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "Nouveau makefile cree."
@@ -721,7 +737,7 @@
 else if $LINUX then
 # Ehouarn : adapt to g95
- set optim="$optim -fmod=$libo"
- set optim90="$optim90 -fmod=$libo"
- set optimtru90="$optimtru90 -fmod=$libo"
+ set optim="$optim -fmod=${libo}"
+ set optim90="$optim90 -fmod=${libo}"
+ set optimtru90="$optimtru90 -fmod=${libo}"
 # Ehouarn: remove set mod_loc_dir def below; mod_loc_dir=$localdir (set above)
 # set mod_loc_dir=$libo
@@ -741,25 +757,26 @@
 cd $localdir
 
-## locate main program (could be in dyn3d or phy$physique
-##                      and could be .F or .F90)
+## locate main program (could be in dyn3d or dynlonlat_phylonlat/phy$physique
+##  or phy$physique/dyn1d   and could be .F or .F90)
 set source_code=${code}.F
+set dirmain=dyn${dimc}d
 if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F90 ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F90
 endif
-
-## locate directory where main program is located
-if ( $dimension == 3 ) then
-  if ( -f $LMDGCM/libf/dyn3d/${source_code} ) then
-    set dyn="DIRMAIN=dyn3d "
-  endif
-  if ( -f $LMDGCM/libf/phy${physique}/${source_code} ) then
-    set dyn="DIRMAIN=phy${physique} "
-  endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -772,8 +789,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -786,4 +804,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -798,8 +817,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -812,7 +832,8 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
 
-# cleanup, remove dimensions.h 
+# cleanup, remove dimensions.h
 \rm -f $libf/grid/dimensions.h
Index: /trunk/LMDZ.MARS/makegcm_gfortran
===================================================================
--- /trunk/LMDZ.MARS/makegcm_gfortran	(revision 1402)
+++ /trunk/LMDZ.MARS/makegcm_gfortran	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=mars
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -14,4 +14,7 @@
 set dyntype="dyn"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -403,6 +406,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs aerono$physique phy$physique"
+   set include="$include "'-I$(LIBF)/aerono'"$physique"' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 # choix du nombre de traceur par defaut si il n'a pas ete choisi,
@@ -486,10 +493,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -550,5 +562,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -590,6 +607,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -633,9 +655,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "On recree le makefile"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "Nouveau makefile cree."
@@ -738,25 +757,26 @@
 cd $localdir
 
-## locate main program (could be in dyn3d or phy$physique
-##                      and could be .F or .F90)
+## locate main program (could be in dyn3d or dynlonlat_phylonlat/phy$physique
+##  or phy$physique/dyn1d   and could be .F or .F90)
 set source_code=${code}.F
+set dirmain=dyn${dimc}d
 if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F90 ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F90
 endif
-
-## locate directory where main program is located
-if ( $dimension == 3 ) then
-  if ( -f $LMDGCM/libf/dyn3d/${source_code} ) then
-    set dyn="DIRMAIN=dyn3d "
-  endif
-  if ( -f $LMDGCM/libf/phy${physique}/${source_code} ) then
-    set dyn="DIRMAIN=phy${physique} "
-  endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -769,8 +789,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -783,4 +804,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -795,8 +817,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -809,4 +832,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
Index: /trunk/LMDZ.MARS/makegcm_ifort
===================================================================
--- /trunk/LMDZ.MARS/makegcm_ifort	(revision 1402)
+++ /trunk/LMDZ.MARS/makegcm_ifort	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=mars
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -14,4 +14,7 @@
 set dyntype="dyn"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -416,6 +419,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs aerono$physique phy$physique"
+   set include="$include "'-I$(LIBF)/aerono'"$physique"' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 # choix du nombre de traceur par defaut si il n'a pas ete choisi,
@@ -499,10 +506,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -563,5 +575,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -603,6 +620,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -646,9 +668,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "On recree le makefile"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "Nouveau makefile cree."
@@ -750,25 +769,26 @@
 cd $localdir
 
-## locate main program (could be in dyn3d or phy$physique
-##                      and could be .F or .F90)
+## locate main program (could be in dyn3d or dynlonlat_phylonlat/phy$physique
+##  or phy$physique/dyn1d   and could be .F or .F90)
 set source_code=${code}.F
+set dirmain=dyn${dimc}d
 if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F90 ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F90
 endif
-
-## locate directory where main program is located
-if ( $dimension == 3 ) then
-  if ( -f $LMDGCM/libf/dyn3d/${source_code} ) then
-    set dyn="DIRMAIN=dyn3d "
-  endif
-  if ( -f $LMDGCM/libf/phy${physique}/${source_code} ) then
-    set dyn="DIRMAIN=phy${physique} "
-  endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -781,8 +801,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -795,4 +816,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -807,8 +829,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -821,7 +844,8 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
 
-# cleanup, remove dimensions.h 
+# cleanup, remove dimensions.h
 \rm -f $libf/grid/dimensions.h
Index: /trunk/LMDZ.MARS/makegcm_pgf
===================================================================
--- /trunk/LMDZ.MARS/makegcm_pgf	(revision 1402)
+++ /trunk/LMDZ.MARS/makegcm_pgf	(revision 1403)
@@ -8,5 +8,5 @@
 set physique=mars
 set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. -I$(LIBF)/aeronomars'
+set include='-I$(LIBF)/grid -I$(LIBF)/misc -I. -I$(LIBF)/dynlonlat_phylonlat'
 set ntrac = 1
 set filtre=filtrez
@@ -14,4 +14,7 @@
 set dyntype="dyn"
 set full=""
+#src_dirs: directories containing source files 
+set src_dirs="grid misc" 
+
 ########################################################################
 # path a changer contenant les sources et les objets du modele
@@ -27,5 +30,5 @@
 ## NetCDF Libraries: what follows is OK for LMD 32 and 64bit Linux Machines
 #if ( `uname -m` == "x86_64" ) then
-## 64 bit machines
+# 64 bit machines
   setenv NCDFLIB /donnees/emlmd/netcdf64-4.0.1_pgi/lib
   setenv NCDFINC /donnees/emlmd/netcdf64-4.0.1_pgi/include
@@ -35,5 +38,4 @@
 #endif
 ####
-
 
 setenv localdir "`pwd`"
@@ -221,9 +223,10 @@
 endif
 
-set nomlib=$machine
+# Ehouarn: add 'g9fortran' string to pathname
+set nomlib=${machine}
 
 # Impose distinct name for 64 bit Linux machines (to avoid mixing 32 and 64)
 if (`uname` == Linux && `uname -m` == "x86_64") then
-  set nomlib=${machine}64
+  set nomlib=${machine}
 endif
 
@@ -407,6 +410,10 @@
 if ( "$physique" == 'nophys' ) then
    set phys="L_PHY= LIBPHY="
-endif
-
+else
+   set src_dirs="$src_dirs aerono$physique phy$physique"
+   set include="$include "'-I$(LIBF)/aerono'"$physique"' -I$(LIBF)/phy'"$physique"
+endif
+set libdyn_phy=""
+set LIBDYN_PHYS=""
 ########################################################################
 # choix du nombre de traceur par defaut si il n'a pas ete choisi,
@@ -490,10 +497,15 @@
   set include="$include "'-I$(LIBF)/dyn2d '
   set dimh=$dim
-else
+endif
+if ( "$dimc" == "3" ) then
   if ( "$dyntype" == "olddyn" ) then
     set include="$include "'-I$(LIBF)/olddyn3d '
+    set src_dirs="$src_dirs olddyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   else
     set include="$include "'-I$(LIBF)/dyn3d '
+    set src_dirs="$src_dirs dyn3d dynlonlat_phylonlat dynlonlat_phylonlat/phy$physique"
   endif
+  set libdyn_phy="-ldynlonlat_phylonlat"
+  set LIBDYN_PHYS='$(LIBO)/libdynlonlat_phylonlat.a'
   set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
 endif
@@ -554,5 +566,10 @@
 ## NB: we still need to have L_DYN=libdyn3d to reach routines and module
 ## objects which are located in dyn3d
-  set dyn="L_DYN=-ldyn3d DYN= L_FILTRE= DIRMAIN=phy$physique "
+  set dyntype=""
+  set filtre="L_DYN= DYN= FILTRE= L_FILTRE= "
+  set dyn="L_DYN= DYN= L_FILTRE= "
+  set dirmain="phy$physique/dyn1d"
+  set src_dirs="$src_dirs phy$physique/dyn1d "
+  set include="$include "' -I$(LIBF)/phy'"$physique"'/dyn1d'
 endif
 endif
@@ -594,6 +611,11 @@
 if ( `expr $dimc \> 2` == 1 ) then
    set filtre="FILTRE=$filtre"
+   if ( "$dyntype" == "olddyn" ) then
+     set src_dirs="$src_dirs oldfiltrez"
+   else
+     set src_dirs="$src_dirs filtrez"
+   endif
 else
-   set filtre="FILTRE= L_FILTRE= "
+   set filtre="FILTRE= L_FILTRE= L_DYN= "
 endif
 echo "MACRO FILTRE $filtre"
@@ -637,9 +659,6 @@
         \cp tmp90 liste_des_sources_f90
         echo "On recree le makefile"
-        if ("$dyntype" == "olddyn") then
-          ./create_make_gcm olddyn3d grid bibio aeronomars phy$physique >! tmp
-        else
-          ./create_make_gcm dyn3d grid bibio aeronomars phy$physique >! tmp
-        endif
+        echo "src_dirs: $src_dirs"
+        create_make_gcm $src_dirs >! tmp
         \mv tmp makefile
         echo "Nouveau makefile cree."
@@ -739,25 +758,26 @@
 cd $localdir
 
-## locate main program (could be in dyn3d or phy$physique
-##                      and could be .F or .F90)
+## locate main program (could be in dyn3d or dynlonlat_phylonlat/phy$physique
+##  or phy$physique/dyn1d   and could be .F or .F90)
 set source_code=${code}.F
+set dirmain=dyn${dimc}d
 if ( -f $LMDGCM/libf/dyn3d/${code}.F90 ) then
   set source_code=${code}.F90
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F
 endif
-if ( -f $LMDGCM/libf/phy${physique}/${code}.F90 ) then
+if ( -f $LMDGCM/libf/phy${physique}/dyn1d/${code}.F90 ) then
+  set dirmain=phy${physique}/dyn1d
   set source_code=${code}.F90
 endif
-
-## locate directory where main program is located
-if ( $dimension == 3 ) then
-  if ( -f $LMDGCM/libf/dyn3d/${source_code} ) then
-    set dyn="DIRMAIN=dyn3d "
-  endif
-  if ( -f $LMDGCM/libf/phy${physique}/${source_code} ) then
-    set dyn="DIRMAIN=phy${physique} "
-  endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F
+endif
+if ( -f $LMDGCM/libf/dynlonlat_phylonlat/phy${physique}/${code}.F90 ) then
+  set dirmain=dynlonlat_phylonlat/phy${physique}
+  set source_code=${code}.F90
 endif
 
@@ -770,8 +790,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -784,4 +805,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
@@ -796,8 +818,9 @@
 $filtre \
 LIBO=$libo \
-$dyn \
 $phys \
+LIBDYN_PHYS=${LIBDYN_PHYS} \
 DIM=$dimc \
 DYNTYPE="$dyntype" \
+L_DYN_PHY="$libdyn_phy" \
 L_ADJNT="$adjnt" \
 LOCAL_DIR="$localdir"  \
@@ -810,7 +833,8 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+DIRMAIN=$dirmain \
 SOURCE=$source_code \
 PROG=$code
 
-# cleanup, remove dimensions.h 
+# cleanup, remove dimensions.h
 \rm -f $libf/grid/dimensions.h
Index: /trunk/LMDZ.TITAN/libf/dynlonlat_phylonlat
===================================================================
--- /trunk/LMDZ.TITAN/libf/dynlonlat_phylonlat	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/dynlonlat_phylonlat	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../LMDZ.COMMON/libf/dynlonlat_phylonlat
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/abort_gcm.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/abort_gcm.F	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/abort_gcm.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/abort_gcm.F
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comconst.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comconst.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comconst.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comconst.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comvert.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comvert.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comvert.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comvert.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/control_mod.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/control_mod.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/control_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/control_mod.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/cpdet_mod.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/cpdet_mod.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/cpdet_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/cpdet_mod.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/disvert_noterre.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/disvert_noterre.F	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/disvert_noterre.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/disvert_noterre.F
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/gr_dyn_fi.F
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/infotrac.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/infotrac.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/infotrac.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/infotrac.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/phytitan/iniphysiq.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniprint.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniprint.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/iniprint.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/iniprint.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/logic.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/logic.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/logic.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/logic.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_const_mpi.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_const_mpi.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_const_mpi.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/mod_const_mpi.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_para.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/moyzon_mod.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/moyzon_mod.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/moyzon_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/moyzon_mod.F90
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/paramet.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/paramet.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/paramet.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/paramet.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F	(revision 1403)
@@ -0,0 +1,469 @@
+      PROGRAM rcm1d
+      
+      USE infotrac
+      use control_mod
+      use comgeomphy
+      USE phys_state_var_mod
+      use cpdet_mod, only: ini_cpdet
+      use moyzon_mod, only: plevmoy
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the venusian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 55 layers)
+c  "makelmdz -p titan -d 55 rcm1d"
+
+c It requires the files "rcm1d.def" "physiq.def" "traceur.def"
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget (original Mars version)
+c   ------- Sebastien Lebonnois (Venus version)
+c   
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimsoil.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "logic.h"
+#include "clesphys.h"
+#include "iniprint.h"
+#include "tabcontrol.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unit           ! unite de lecture de "rcm1d.def"
+      INTEGER unitstart      ! unite d'ecriture de "startphy.nc"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day              ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(llm+1) ! intermediate pressure levels (pa)
+      REAL psurf      
+      REAL u(llm),v(llm)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(llm)   ! temperature at the middle of the layers
+      REAL,allocatable :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL zlay(llm)   ! altitude estimee dans les couches (km)
+      REAL long(1),lati(1),area(1)
+      REAL cufi(1),cvfi(1)
+      REAL phisfi(1)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(llm),dv(llm),dtemp(llm)
+      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
+      REAL dpsurf    
+      REAL,allocatable :: dq(:,:)
+
+c   Various intermediate variables
+      REAL zls
+      REAL phi(llm),s(llm)
+      REAL pk(llm),pks, w(llm)
+      INTEGER l, ierr, aslun
+      REAL tmp1(0:llm),tmp2(0:llm),tmp3(0:llm)                        
+
+      character*2 str2
+
+c normalement dans dyn3d/comconst.h
+      COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
+      REAL cppdyn,nu_venus,t0_venus
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+
+      lunout = 6
+
+c ------------------------------------------------------
+c  Constantes prescrites ICI
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Constante de Titan
+c     -------------------
+      planet_type = "titan"
+      rad=2575000.               ! rayon de Venus (m) 
+      daysec=1.37889e6           ! duree du sol (s)  
+      omeg=2*pi/daysec           ! vitesse de rotation (rad.s-1)
+      g= 1.35                    ! gravite (m.s-2)
+      mugaz=28.                  ! Masse molaire de l'atm (g.mol-1) 
+      cpp=1.039e3
+      cppdyn=cpp
+      r= 8.314511E+0 *1000.E+0/mugaz
+      rcp= r/cpp
+
+c-----------------------------------------------------------------------
+c   Initialisation des traceurs
+c   ---------------------------
+c  Choix du nombre de traceurs et du schema pour l'advection
+c  dans fichier traceur.def
+      call infotrac_init
+
+c Allocation de la tableau q : champs advectes   
+      allocate(q(llm,nqtot))
+      allocate(dq(llm,nqtot))
+
+c ------------------------------------------------------
+c  Lecture des parametres dans "rcm1d.def" 
+c ------------------------------------------------------
+
+c   Opening parameters file "rcm1d.def"
+c   ---------------------------------------
+      unit =97
+      OPEN(unit,file='rcm1d.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+
+      IF(ierr.ne.0) THEN
+        write(*,*) 'Problem to open "rcm1d.def'
+        write(*,*) 'Is it there ?'
+        stop
+      END IF
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0
+      PRINT *,'date de depart ?'
+      READ(unit,*) day0
+      day=REAL(day0)
+      PRINT *,day0
+c  Heure de demarrage
+      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
+      READ(unit,*) time
+      time=time/24.E+0
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=llm
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+      PRINT *,'nombre de pas de temps par jour ?'
+      READ(unit,*) day_step
+      print*,day_step
+
+c     PRINT *,'nombre d appel au rayonnement par jour ?'
+c     READ(unit,*) nbapp_rad
+c     print*,nbapp_rad
+c LU DANS PHYSIQ.DEF...
+      nbapp_rad = 100.
+
+      PRINT *,'nombre de jours simules ?'
+      READ(unit,*) ndt
+      print*,ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+      dtime=dtphys
+
+c Pression de surface sur la planete
+c ------------------------------------
+c
+      PRINT *,'pression au sol'
+      READ(unit,*) psurf
+      PRINT *,psurf
+c Pression de reference  
+      pa     =  1.e4 
+      preff  = 1.4e5 
+c     preff  = psurf
+ 
+c  latitude/longitude 
+c  -------------------
+      PRINT *,'latitude en degres ?'
+      READ(unit,*) lati(1)
+      PRINT *,lati(1)
+      long(1)=0.E+0
+
+c   Initialisation speciales "physiq"
+c   ---------------------------------
+
+      CALL init_phys_lmdz(iim,jjm,llm,1,(/1/))
+      call initcomgeomphy
+      call ini_cpdet
+
+c   la surface de chaque maille est inutile en 1D --->
+      area(1)=1.E+0
+c de meme ?
+      cufi(1)=1.E+0
+      cvfi(1)=1.E+0
+
+c   le geopotentiel au sol est inutile en 1D car tout est controle
+c   par la pression de surface --->
+      phisfi(1)=0.E+0
+
+      CALL iniphysiq(1,1,llm,daysec,day0,dtphys,
+     .            lati,long,area,cufi,cvfi,rad,g,r,cpp,1)
+
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+ 
+c    vent geostrophique
+      PRINT *,'composante vers l est du vent geostrophique (U) ?'
+      READ(unit,*) gru
+      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
+      READ(unit,*) grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates  (hybrids)
+c    """"""""""""""""""""
+      CALL  disvert_noterre
+      
+c     Calcul au milieu des couches : Vient de la version Mars
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     C'est fait de la meme facon dans disvert
+
+      DO l = 1, llm
+       aps(l) =  0.5 *( ap(l) +ap(l+1))
+       bps(l) =  0.5 *( bp(l) +bp(l+1))
+      ENDDO
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+      allocate(plevmoy(nlevel))
+      plevmoy(:)=plev(:)
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+        pk(ilayer)  =cpp*(play(ilayer)/preff)**rcp
+c       write(120,*) ilayer,plev(ilayer),play(ilayer)
+      ENDDO
+c     write(120,*) nlevel,plev(nlevel)
+c     stop
+      
+      pks=cpp*(psurf/preff)**rcp
+
+c  init des variables pour phyredem
+c  --------------------------------
+      call phys_state_var_init
+
+c  profil de temperature et altitude au premier appel
+c  --------------------------------------------------
+
+c modif par rapport a Mars: 
+c   on envoie dz/T=-log(play/psurf)*r/g dans profile
+      tmp1(0)=0.0
+      tmp1(1)= -log(play(1)/psurf)*r/g
+      DO ilayer=2,nlayer
+        tmp1(ilayer)=-log(play(ilayer)/play(ilayer-1))*r/g
+      ENDDO
+      DO ilayer=0,nlayer
+        tmp2(ilayer)=plev(ilayer+1)
+      ENDDO
+      call profile(unit,nlayer+1,tmp1,tmp2,tmp3)
+      CLOSE(unit)
+
+      print*,"               Pression        Altitude     Temperature"
+      ilayer=1
+      ftsol(1)=tmp3(0)
+       temp(1)=tmp3(1)
+       zlay(1)=tmp3(1)*tmp1(1)
+      print*,"           0",ftsol(1)
+      print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      DO ilayer=2,nlayer
+        temp(ilayer)=tmp3(ilayer)
+        zlay(ilayer)=zlay(ilayer-1)+tmp3(ilayer)*tmp1(ilayer)
+        print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      ENDDO
+      
+c     temperature du sous-sol
+c     ~~~~~~~~~~~~~~~~~~~~~~~
+      DO isoil=1,nsoil
+         ftsoil(1,isoil)=ftsol(1)
+      ENDDO
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nqtot
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+
+c    Initialisation des parametres d'oro
+c    -----------------------------------
+
+      zmea(1) = 0.
+      zstd(1) = 0.
+      zsig(1) = 0.
+      zgam(1) = 0.
+      zthe(1) = 0.
+      zpic(1) = 0.
+      zval(1) = 0.
+
+c  Initialisation Ls
+c ------------------
+         zls=0.
+         print*,'Ls=',zls*180./pi
+
+c  Initialisation albedo 
+c  ----------------------
+
+      falbe(1)=0.3
+
+c  Ecriture de "startphy.nc"
+c  -------------------------
+c  (Ce fichier sera aussitot relu au premier
+c   appel de "physiq", mais il est necessaire pour passer
+c   les variables purement physiques a "physiq"...
+
+      solsw(1)    = 0.
+      sollw(1)    = 0.
+      fder(1)     = 0.
+      radsol(1)   = 0.
+     
+      radpas      = NINT(1.*day_step/nbapp_rad)
+      soil_model  = .true.
+
+      call phyredem("startphy.nc")
+
+c  deallocation des variables phyredem
+c  -----------------------------------
+      call phys_state_var_end
+
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+        IF (idt.eq.ndt) then 
+         lastcall=.true.
+c        write(103,*) 'Ls=',zls*180./pi
+c        write(103,*) 'Lat=', lati(1)
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(104,*) 'Ls=',zls*180./pi
+c        write(104,*) 'Lat=', lati(1)
+c        write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+! ADAPTATION GCM POUR CP(T)
+      DO ilayer=1,nlayer
+        s(ilayer)=(play(ilayer)/psurf)**rcp
+      ENDDO
+      phi(1)=cpp*temp(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &     cpp*(temp(ilayer-1)/s(ilayer-1)+temp(ilayer)/s(ilayer))*0.5
+     &        *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+      CALL physiq (1,llm,nqtot,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,pk,phi,phisfi,
+     ,     presnivs,
+     ,     u,v,temp,q,  
+     ,     w,
+C - sorties
+     s     du,dv,dtemp,dq,dpsurf)
+
+c     print*,"DT APRES PHYSIQ=",day,time
+c     print*,dtemp
+c     print*,temp
+c     print*," "
+c     stop
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       Pas de coriolis 
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c      
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+      ENDDO   ! fin de la boucle temporelle
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+
+        print*,"Temperature finale:"
+        print*,temp
+        
+c stabilite
+      DO ilayer=1,nlayer
+        zlay(ilayer) = phi(ilayer)/g/1000.  !en km
+      ENDDO
+      DO ilayer=2,nlayer
+        tmp1(ilayer) =
+     .    (temp(ilayer)-temp(ilayer-1))/(zlay(ilayer)-zlay(ilayer-1)) 
+     .   + 1000.*g/cpp
+      ENDDO
+
+      OPEN(11,file='profile.new')
+      DO ilayer=1,nlayer
+        write (11,*) zlay(ilayer),temp(ilayer),tmp1(ilayer)
+      ENDDO
+
+c    ========================================================
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+!#include "../dyn3d_common/disvert_noterre.F"
+!#include "../dyn3d/abort_gcm.F"
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/temps.h
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/temps.h	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/temps.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/temps.h
Index: /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/write_field.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/write_field.F90	(revision 1403)
+++ /trunk/LMDZ.TITAN/libf/phytitan/dyn1d/write_field.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/write_field.F90
Index: unk/LMDZ.TITAN/libf/phytitan/ini_archive.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/ini_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,355 +1,0 @@
-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: unk/LMDZ.TITAN/libf/phytitan/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F90	(revision 1402)
+++ 	(revision )
@@ -1,195 +1,0 @@
-
-! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
-
-
-SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
-                     rlatu,rlonv,aire,cu,cv,                             &
-                     prad,pg,pr,pcpp,iflag_phys)
-  USE dimphy, ONLY: klev ! number of atmospheric levels
-  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
-                                        ! (on full grid)
-  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
-                                klon_omp_begin, & ! start index of local omp subgrid
-                                klon_omp_end, & ! end index of local omp subgrid
-                                klon_mpi_begin ! start indes of columns (on local mpi grid)
-  USE comgeomphy, ONLY: initcomgeomphy, &
-                        airephy, & ! physics grid area (m2)
-                        cuphy, & ! cu coeff. (u_covariant = cu * u)
-                        cvphy, & ! cv coeff. (v_covariant = cv * v)
-                        rlond, & ! longitudes
-                        rlatd ! latitudes
-  IMPLICIT NONE
-
-  ! =======================================================================
-  ! Initialisation of the physical constants and some positional and
-  ! geometrical arrays for the physics
-  ! =======================================================================
-
-  include "YOMCST.h"
-  include "iniprint.h"
-
-  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) :: nlayer ! number of atmospheric layers
-  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
-  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
-  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
-  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
-  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
-  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
-  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! 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 :: ibegin, iend, offset
-  INTEGER :: i,j
-  CHARACTER (LEN=20) :: modname = 'iniphysiq'
-  CHARACTER (LEN=80) :: abort_message
-  REAL :: total_area_phy, total_area_dyn
-
-
-  ! global array, on full physics grid:
-  REAL,ALLOCATABLE :: latfi(:)
-  REAL,ALLOCATABLE :: lonfi(:)
-  REAL,ALLOCATABLE :: cufi(:)
-  REAL,ALLOCATABLE :: cvfi(:)
-  REAL,ALLOCATABLE :: airefi(:)
-
-  IF (nlayer/=klev) THEN
-    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)
-  END IF
-
-  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-  
-  ! Generate global arrays on full physics grid
-  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
-  ALLOCATE(airefi(klon_glo))
-
-  IF (klon_glo>1) THEN ! general case
-    ! North pole
-    latfi(1)=rlatu(1)
-    lonfi(1)=0.
-    cufi(1) = cu(1)
-    cvfi(1) = cv(1)
-    DO j=2,jjm
-      DO i=1,iim
-        latfi((j-2)*iim+1+i)= rlatu(j)
-        lonfi((j-2)*iim+1+i)= rlonv(i)
-        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
-        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
-      ENDDO
-    ENDDO
-    ! South pole
-    latfi(klon_glo)= rlatu(jjm+1)
-    lonfi(klon_glo)= 0.
-    cufi(klon_glo) = cu((iim+1)*jjm+1)
-    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
-
-    ! build airefi(), mesh area on physics grid
-    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
-    ! Poles are single points on physics grid
-    airefi(1)=sum(aire(1:iim,1))
-    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
-
-    ! Sanity check: do total planet area match between physics and dynamics?
-    total_area_dyn=sum(aire(1:iim,1:jjm+1))
-    total_area_phy=sum(airefi(1:klon_glo))
-    IF (total_area_dyn/=total_area_phy) THEN
-      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
-      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
-      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
-      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
-        ! stop here if the relative difference is more than 0.001%
-        abort_message = 'planet total surface discrepancy'
-        CALL abort_gcm(modname, abort_message, 1)
-      ENDIF
-    ENDIF
-  ELSE ! klon_glo==1, running the 1D model
-    ! just copy over input values
-    latfi(1)=rlatu(1)
-    lonfi(1)=rlonv(1)
-    cufi(1)=cu(1)
-    cvfi(1)=cv(1)
-    airefi(1)=aire(1,1)
-  ENDIF ! of IF (klon_glo>1)
-
-!$OMP PARALLEL 
-  ! Now generate local lon/lat/cu/cv/area arrays
-  CALL initcomgeomphy
-
-  offset = klon_mpi_begin - 1
-  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
-  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
-  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
-  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
-  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
-
-  ! Initialize some physical constants
-  call suphec
-
-!$OMP END PARALLEL
-
-  ! check that physical constants set in 'suphec' are coherent
-  ! with values set in the dynamics:
-  IF (rday/=punjours) THEN
-    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
-    WRITE (lunout, *) '  in the dynamics punjours=', punjours
-    WRITE (lunout, *) '   but in the physics RDAY=', rday
-    IF (abs(rday-punjours)>0.01*punjours) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'length of day discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-
-  IF (rg/=pg) THEN
-    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pg=', pg
-    WRITE (lunout, *) '  but in the physics RG=', rg
-    IF (abs(rg-pg)>0.01*pg) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'gravity discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (ra/=prad) THEN
-    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
-    WRITE (lunout, *) '   in the dynamics prad=', prad
-    WRITE (lunout, *) '  but in the physics RA=', ra
-    IF (abs(ra-prad)>0.01*prad) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'planet radius discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rd/=pr) THEN
-    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pr=', pr
-    WRITE (lunout, *) '  but in the physics RD=', rd
-    IF (abs(rd-pr)>0.01*pr) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'reduced gas constant discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rcpd/=pcpp) THEN
-    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
-    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
-    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'specific heat discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-
-END SUBROUTINE iniphysiq
Index: unk/LMDZ.TITAN/libf/phytitan/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_grid_phy_lmdz.F90	(revision 1402)
+++ 	(revision )
@@ -1,447 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_grid_phy_lmdz
-
-  PUBLIC
-  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
-             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
-
-  INTEGER,SAVE :: nbp_lon  ! == iim
-  INTEGER,SAVE :: nbp_lat  ! == jjmp1
-  INTEGER,SAVE :: nbp_lev  ! == llm
-  INTEGER,SAVE :: klon_glo
-
-  INTERFACE grid1dTo2d_glo
-    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
-                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
-		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
-   END INTERFACE 
-
-   INTERFACE grid2dTo1d_glo
-    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
-                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
-		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
-   END INTERFACE 
- 
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
-  IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjp1
-  INTEGER, INTENT(in) :: llm
-  
-    nbp_lon=iim
-    nbp_lat=jjp1
-    nbp_lev=llm
-    klon_glo=(iim*jjp1)-2*(iim-1)
-  
-  END SUBROUTINE init_grid_phy_lmdz
-  
-  
-  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_i
-  
-
-  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_i1
-
-  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_i2
-  
-  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_i3
-
-
-  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_r
-  
-
-  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_r1
-
-  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_r2
-  
-  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_l
-  
-
-  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_l1
-
-  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_l2
-  
-  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_l3  
-  
-    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_i
-  
-
-  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_i1
-
-  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_i2
-  
-  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_r
-  
-
-  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_r1
-
-  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_r2
-  
-  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_r3
-
-
-
-  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_l
-  
-
-  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_l1
-
-  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_l2
-  
-  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_l3
-
-!---------------------------------------------------------------- 
-!  fonctions generiques (privees)
-!---------------------------------------------------------------- 
-  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_igen   
-
-
-  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-   
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_rgen   
-
-  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_lgen     
-  
-  
-  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_igen   
-  
-  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_rgen 
-    
-  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_lgen   
-
-END MODULE mod_grid_phy_lmdz
Index: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,203 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1902 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1057 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,113 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_transfert_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,1275 +1,0 @@
-!
-!$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: unk/LMDZ.TITAN/libf/phytitan/newstart.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/newstart.F	(revision 1402)
+++ 	(revision )
@@ -1,1138 +1,0 @@
-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
-      use exner_hyb_m, only: exner_hyb
-      use exner_milieu_m, only: exner_milieu
-
-      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,razvitu,razvitv 
-      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--------------------------------------------------------------
-
-!!! ATTENTION TEMPORAIRE
-c     ps(:,:)=146700.
-
-      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, pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
-           CALL exner_milieu( ip1jmp1, ps, p3d, pks, pk, pkf )
-         endif
-      
-c temperatures atmospheriques
-
-c ATTENTION: peut servir, mais bon...
-c     do l=1,lmold
-c      do j=1,jmold+1
-c       do i=1,imold+1
-c modif: profil uniforme
-c          told(i,j,l)=told(1,jmold/2,l)
-c mean T profile:
-c       told(i,j,l) = 142.1*exp(-((p3d(i,j,l)/100.+21.45)/40.11)**2.) 
-c    .              + 106.3*exp(-((p3d(i,j,l)/100.-3183.)/4737.)**2.)
-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,:,:)
-
-! RESETING U TO 0: may be done through run.def
-       razvitu = . FALSE .
-       CALL getin('razvitu',razvitu)
-       razvitv = . FALSE .
-       CALL getin('razvitv',razvitv)
-
-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)
-! Reseting u=0
-      if (razvitu) then
-           unat(:,:,:) = 0.
-      endif
-      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
-! Reseting v=0
-      if (razvitv) then
-           vnat(:,:,:) = 0.
-      endif
-      write (*,*) 'vnat ', vnat (1,2,1)    ! INFO
-      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: unk/LMDZ.TITAN/libf/phytitan/rcm1d.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F	(revision 1402)
+++ 	(revision )
@@ -1,469 +1,0 @@
-      PROGRAM rcm1d
-      
-      USE infotrac
-      use control_mod
-      use comgeomphy
-      USE phys_state_var_mod
-      use cpdet_mod, only: ini_cpdet
-      use moyzon_mod, only: plevmoy
-      IMPLICIT NONE
-
-c=======================================================================
-c   subject:
-c   --------
-c   PROGRAM useful to run physical part of the venusian GCM in a 1D column
-c       
-c Can be compiled with a command like (e.g. for 55 layers)
-c  "makelmdz -p titan -d 55 rcm1d"
-
-c It requires the files "rcm1d.def" "physiq.def" "traceur.def"
-c      and a file describing the sigma layers (e.g. "z2sig.def")
-c
-c   author: Frederic Hourdin, R.Fournier,F.Forget (original Mars version)
-c   ------- Sebastien Lebonnois (Venus version)
-c   
-c=======================================================================
-
-#include "dimensions.h"
-#include "dimsoil.h"
-#include "comcstfi.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "logic.h"
-#include "clesphys.h"
-#include "iniprint.h"
-#include "tabcontrol.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unit           ! unite de lecture de "rcm1d.def"
-      INTEGER unitstart      ! unite d'ecriture de "startphy.nc"
-      INTEGER nlayer,nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day              ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(llm+1) ! intermediate pressure levels (pa)
-      REAL psurf      
-      REAL u(llm),v(llm)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(llm)   ! temperature at the middle of the layers
-      REAL,allocatable :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
-      REAL zlay(llm)   ! altitude estimee dans les couches (km)
-      REAL long(1),lati(1),area(1)
-      REAL cufi(1),cvfi(1)
-      REAL phisfi(1)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(llm),dv(llm),dtemp(llm)
-      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
-      REAL,allocatable :: dq(:,:)
-
-c   Various intermediate variables
-      REAL zls
-      REAL phi(llm),s(llm)
-      REAL pk(llm),pks, w(llm)
-      INTEGER l, ierr, aslun
-      REAL tmp1(0:llm),tmp2(0:llm),tmp3(0:llm)                        
-
-      character*2 str2
-
-c normalement dans dyn3d/comconst.h
-      COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
-      REAL cppdyn,nu_venus,t0_venus
-
-c=======================================================================
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-
-      lunout = 6
-
-c ------------------------------------------------------
-c  Constantes prescrites ICI
-c ------------------------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Constante de Titan
-c     -------------------
-      planet_type = "titan"
-      rad=2575000.               ! rayon de Venus (m) 
-      daysec=1.37889e6           ! duree du sol (s)  
-      omeg=2*pi/daysec           ! vitesse de rotation (rad.s-1)
-      g= 1.35                    ! gravite (m.s-2)
-      mugaz=28.                  ! Masse molaire de l'atm (g.mol-1) 
-      cpp=1.039e3
-      cppdyn=cpp
-      r= 8.314511E+0 *1000.E+0/mugaz
-      rcp= r/cpp
-
-c-----------------------------------------------------------------------
-c   Initialisation des traceurs
-c   ---------------------------
-c  Choix du nombre de traceurs et du schema pour l'advection
-c  dans fichier traceur.def
-      call infotrac_init
-
-c Allocation de la tableau q : champs advectes   
-      allocate(q(llm,nqtot))
-      allocate(dq(llm,nqtot))
-
-c ------------------------------------------------------
-c  Lecture des parametres dans "rcm1d.def" 
-c ------------------------------------------------------
-
-c   Opening parameters file "rcm1d.def"
-c   ---------------------------------------
-      unit =97
-      OPEN(unit,file='rcm1d.def',status='old',form='formatted'
-     .     ,iostat=ierr)
-
-      IF(ierr.ne.0) THEN
-        write(*,*) 'Problem to open "rcm1d.def'
-        write(*,*) 'Is it there ?'
-        stop
-      END IF
-
-c  Date et heure locale du debut du run
-c  ------------------------------------
-c    Date (en sols depuis le solstice de printemps) du debut du run
-      day0 = 0
-      PRINT *,'date de depart ?'
-      READ(unit,*) day0
-      day=REAL(day0)
-      PRINT *,day0
-c  Heure de demarrage
-      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
-      READ(unit,*) time
-      time=time/24.E+0
-
-c  Discretisation (Definition de la grille et des pas de temps)
-c  --------------
-c
-      nlayer=llm
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-      PRINT *,'nombre de pas de temps par jour ?'
-      READ(unit,*) day_step
-      print*,day_step
-
-c     PRINT *,'nombre d appel au rayonnement par jour ?'
-c     READ(unit,*) nbapp_rad
-c     print*,nbapp_rad
-c LU DANS PHYSIQ.DEF...
-      nbapp_rad = 100.
-
-      PRINT *,'nombre de jours simules ?'
-      READ(unit,*) ndt
-      print*,ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-      dtime=dtphys
-
-c Pression de surface sur la planete
-c ------------------------------------
-c
-      PRINT *,'pression au sol'
-      READ(unit,*) psurf
-      PRINT *,psurf
-c Pression de reference  
-      pa     =  1.e4 
-      preff  = 1.4e5 
-c     preff  = psurf
- 
-c  latitude/longitude 
-c  -------------------
-      PRINT *,'latitude en degres ?'
-      READ(unit,*) lati(1)
-      PRINT *,lati(1)
-      long(1)=0.E+0
-
-c   Initialisation speciales "physiq"
-c   ---------------------------------
-
-      CALL init_phys_lmdz(iim,jjm,llm,1,(/1/))
-      call initcomgeomphy
-      call ini_cpdet
-
-c   la surface de chaque maille est inutile en 1D --->
-      area(1)=1.E+0
-c de meme ?
-      cufi(1)=1.E+0
-      cvfi(1)=1.E+0
-
-c   le geopotentiel au sol est inutile en 1D car tout est controle
-c   par la pression de surface --->
-      phisfi(1)=0.E+0
-
-      CALL iniphysiq(1,1,llm,daysec,day0,dtphys,
-     .            lati,long,area,cufi,cvfi,rad,g,r,cpp,1)
-
-c   Initialisation pour prendre en compte les vents en 1-D
-c   ------------------------------------------------------
- 
-c    vent geostrophique
-      PRINT *,'composante vers l est du vent geostrophique (U) ?'
-      READ(unit,*) gru
-      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
-      READ(unit,*) grv
-
-c     Initialisation des vents  au premier pas de temps
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c  calcul des pressions et altitudes en utilisant les niveaux sigma
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates  (hybrids)
-c    """"""""""""""""""""
-      CALL  disvert_noterre
-      
-c     Calcul au milieu des couches : Vient de la version Mars
-c     WARNING : le choix de placer le milieu des couches au niveau de
-c     pression intermédiaire est arbitraire et pourrait etre modifié.
-c     C'est fait de la meme facon dans disvert
-
-      DO l = 1, llm
-       aps(l) =  0.5 *( ap(l) +ap(l+1))
-       bps(l) =  0.5 *( bp(l) +bp(l+1))
-      ENDDO
-
-      DO ilevel=1,nlevel
-        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-      ENDDO
-      allocate(plevmoy(nlevel))
-      plevmoy(:)=plev(:)
-
-      DO ilayer=1,nlayer
-        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-        pk(ilayer)  =cpp*(play(ilayer)/preff)**rcp
-c       write(120,*) ilayer,plev(ilayer),play(ilayer)
-      ENDDO
-c     write(120,*) nlevel,plev(nlevel)
-c     stop
-      
-      pks=cpp*(psurf/preff)**rcp
-
-c  init des variables pour phyredem
-c  --------------------------------
-      call phys_state_var_init
-
-c  profil de temperature et altitude au premier appel
-c  --------------------------------------------------
-
-c modif par rapport a Mars: 
-c   on envoie dz/T=-log(play/psurf)*r/g dans profile
-      tmp1(0)=0.0
-      tmp1(1)= -log(play(1)/psurf)*r/g
-      DO ilayer=2,nlayer
-        tmp1(ilayer)=-log(play(ilayer)/play(ilayer-1))*r/g
-      ENDDO
-      DO ilayer=0,nlayer
-        tmp2(ilayer)=plev(ilayer+1)
-      ENDDO
-      call profile(unit,nlayer+1,tmp1,tmp2,tmp3)
-      CLOSE(unit)
-
-      print*,"               Pression        Altitude     Temperature"
-      ilayer=1
-      ftsol(1)=tmp3(0)
-       temp(1)=tmp3(1)
-       zlay(1)=tmp3(1)*tmp1(1)
-      print*,"           0",ftsol(1)
-      print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
-      DO ilayer=2,nlayer
-        temp(ilayer)=tmp3(ilayer)
-        zlay(ilayer)=zlay(ilayer-1)+tmp3(ilayer)*tmp1(ilayer)
-        print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
-      ENDDO
-      
-c     temperature du sous-sol
-c     ~~~~~~~~~~~~~~~~~~~~~~~
-      DO isoil=1,nsoil
-         ftsoil(1,isoil)=ftsol(1)
-      ENDDO
-
-c    Initialisation des traceurs
-c    ---------------------------
-
-      DO iq=1,nqtot
-        DO ilayer=1,nlayer
-           q(ilayer,iq) = 0.
-        ENDDO
-      ENDDO
-
-c    Initialisation des parametres d'oro
-c    -----------------------------------
-
-      zmea(1) = 0.
-      zstd(1) = 0.
-      zsig(1) = 0.
-      zgam(1) = 0.
-      zthe(1) = 0.
-      zpic(1) = 0.
-      zval(1) = 0.
-
-c  Initialisation Ls
-c ------------------
-         zls=0.
-         print*,'Ls=',zls*180./pi
-
-c  Initialisation albedo 
-c  ----------------------
-
-      falbe(1)=0.3
-
-c  Ecriture de "startphy.nc"
-c  -------------------------
-c  (Ce fichier sera aussitot relu au premier
-c   appel de "physiq", mais il est necessaire pour passer
-c   les variables purement physiques a "physiq"...
-
-      solsw(1)    = 0.
-      sollw(1)    = 0.
-      fder(1)     = 0.
-      radsol(1)   = 0.
-     
-      radpas      = NINT(1.*day_step/nbapp_rad)
-      soil_model  = .true.
-
-      call phyredem("startphy.nc")
-
-c  deallocation des variables phyredem
-c  -----------------------------------
-      call phys_state_var_end
-
-c=======================================================================
-c  BOUCLE TEMPORELLE DU MODELE 1D 
-c=======================================================================
-c
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-        IF (idt.eq.ndt) then 
-         lastcall=.true.
-c        write(103,*) 'Ls=',zls*180./pi
-c        write(103,*) 'Lat=', lati(1)
-c        write(103,*) 'RunEnd - Atmos. Temp. File'
-c        write(103,*) 'RunEnd - Atmos. Temp. File'
-c        write(104,*) 'Ls=',zls*180./pi
-c        write(104,*) 'Lat=', lati(1)
-c        write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c    calcul du geopotentiel 
-c     ~~~~~~~~~~~~~~~~~~~~~
-! ADAPTATION GCM POUR CP(T)
-      DO ilayer=1,nlayer
-        s(ilayer)=(play(ilayer)/psurf)**rcp
-      ENDDO
-      phi(1)=cpp*temp(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &     cpp*(temp(ilayer-1)/s(ilayer-1)+temp(ilayer)/s(ilayer))*0.5
-     &        *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       appel de la physique
-c       --------------------
-
-      CALL physiq (1,llm,nqtot,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,pk,phi,phisfi,
-     ,     presnivs,
-     ,     u,v,temp,q,  
-     ,     w,
-C - sorties
-     s     du,dv,dtemp,dq,dpsurf)
-
-c     print*,"DT APRES PHYSIQ=",day,time
-c     print*,dtemp
-c     print*,temp
-c     print*," "
-c     stop
-
-c       evolution du vent : modele 1D
-c       -----------------------------
- 
-c       la physique calcule les derivees temporelles de u et v.
-c       Pas de coriolis 
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c      
-c       Calcul du temps au pas de temps suivant
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       calcul des vitesses et temperature au pas de temps suivant
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       calcul des pressions au pas de temps suivant
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
-           DO ilevel=1,nlevel
-             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-      ENDDO   ! fin de la boucle temporelle
-
-c    ========================================================
-c    GESTION DES SORTIE
-c    ========================================================
-
-        print*,"Temperature finale:"
-        print*,temp
-        
-c stabilite
-      DO ilayer=1,nlayer
-        zlay(ilayer) = phi(ilayer)/g/1000.  !en km
-      ENDDO
-      DO ilayer=2,nlayer
-        tmp1(ilayer) =
-     .    (temp(ilayer)-temp(ilayer-1))/(zlay(ilayer)-zlay(ilayer-1)) 
-     .   + 1000.*g/cpp
-      ENDDO
-
-      OPEN(11,file='profile.new')
-      DO ilayer=1,nlayer
-        write (11,*) zlay(ilayer),temp(ilayer),tmp1(ilayer)
-      ENDDO
-
-c    ========================================================
-      END
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d_common/disvert_noterre.F"
-#include "../dyn3d/abort_gcm.F"
Index: unk/LMDZ.TITAN/libf/phytitan/readstart.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/readstart.F	(revision 1402)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $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: unk/LMDZ.TITAN/libf/phytitan/start2archive.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/start2archive.F	(revision 1402)
+++ 	(revision )
@@ -1,317 +1,0 @@
-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,ini_cpdet
-      use exner_hyb_m, only: exner_hyb
-      use exner_milieu_m, only: exner_milieu
-
-      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 conf_gcm( 99, .TRUE. )
-      call iniconst
-      call inigeom
-      call inifilr
-      call ini_cpdet
-
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-         if (disvert_type==1) then
-           CALL exner_hyb(  ip1jmp1, ps, p3d, pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
-           CALL exner_milieu( ip1jmp1, ps, p3d, 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: unk/LMDZ.TITAN/libf/phytitan/startvar.F90
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/startvar.F90	(revision 1402)
+++ 	(revision )
@@ -1,770 +1,0 @@
-!
-! $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: unk/LMDZ.TITAN/libf/phytitan/write_archive.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/write_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,197 +1,0 @@
-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: unk/LMDZ.TITAN/libf/phytitan/writerestart.F
===================================================================
--- /trunk/LMDZ.TITAN/libf/phytitan/writerestart.F	(revision 1402)
+++ 	(revision )
@@ -1,495 +1,0 @@
-      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.VENUS/libf/dynlonlat_phylonlat
===================================================================
--- /trunk/LMDZ.VENUS/libf/dynlonlat_phylonlat	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/dynlonlat_phylonlat	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../LMDZ.COMMON/libf/dynlonlat_phylonlat
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/abort_gcm.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/abort_gcm.F	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/abort_gcm.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/abort_gcm.F
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comconst.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comconst.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comconst.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comconst.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comgeom.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom2.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom2.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comgeom2.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comgeom2.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comvert.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comvert.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/comvert.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/comvert.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/control_mod.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/control_mod.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/control_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/control_mod.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/cpdet_mod.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/cpdet_mod.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/cpdet_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/cpdet_mod.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/disvert_noterre.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/disvert_noterre.F	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/disvert_noterre.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/disvert_noterre.F
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/gr_dyn_fi.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/gr_dyn_fi.F	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/gr_dyn_fi.F
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/infotrac.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/infotrac.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/infotrac.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/infotrac.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniphysiq.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/phyvenus/iniphysiq.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniprint.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniprint.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/iniprint.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/iniprint.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/logic.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/logic.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/logic.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/logic.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_const_mpi.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_const_mpi.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_const_mpi.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/mod_const_mpi.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_interface_dyn_phys.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_interface_dyn_phys.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_interface_dyn_phys.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_interface_dyn_phys.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_para.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/moyzon_mod.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/moyzon_mod.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/moyzon_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/moyzon_mod.F90
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/paramet.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/paramet.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/paramet.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/paramet.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F	(revision 1403)
@@ -0,0 +1,477 @@
+      PROGRAM rcm1d
+      
+      USE infotrac
+      use control_mod
+      use comgeomphy
+      USE phys_state_var_mod
+      use chemparam_mod
+      use cpdet_mod, only: ini_cpdet
+      use moyzon_mod, only: tmoy
+
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the venusian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 50 layers)
+c  "makelmdz -p venus -d 50 rcm1d"
+
+c It requires the files "rcm1d.def" "physiq.def"
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget (original Mars version)
+c   ------- Sebastien Lebonnois (Venus version)
+c   
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimsoil.h"
+#include "comcstfi.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "logic.h"
+#include "clesphys.h"
+#include "iniprint.h"
+#include "tabcontrol.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unit           ! unite de lecture de "rcm1d.def"
+      INTEGER unitstart      ! unite d'ecriture de "startphy.nc"
+      INTEGER nlayer,nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day              ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(llm+1) ! intermediate pressure levels (pa)
+      REAL psurf      
+      REAL u(llm),v(llm)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(llm)   ! temperature at the middle of the layers
+      REAL,allocatable :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL zlay(llm)   ! altitude estimee dans les couches (km)
+      REAL long(1),lati(1),area(1)
+      REAL cufi(1),cvfi(1)
+      REAL phisfi(1)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(llm),dv(llm),dtemp(llm)
+      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
+      REAL dpsurf    
+      REAL,allocatable :: dq(:,:)
+
+c   Various intermediate variables
+      REAL zls
+      REAL phi(llm),s(llm)
+      REAL pk(llm),pks, w(llm)
+      INTEGER l, ierr, aslun
+      REAL tmp1(0:llm),tmp2(0:llm)                        
+
+      character*2 str2
+
+c normalement dans dyn3d/comconst.h
+      COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
+      REAL cppdyn,nu_venus,t0_venus
+      real pi
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+
+      lunout = 6
+
+c ------------------------------------------------------
+c  Constantes prescrites ICI
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Constante de la Planete Venus
+c     -----------------------------
+      planet_type = "venus"
+      rad=6051300.               ! rayon de Venus (m)  ~6051300 m
+      daysec= 1.0087e7           ! duree du sol (s)  ~1.e7 s
+      omeg=4.*asin(1.)/19.4141e6 ! vitesse de rotation (rad.s-1)
+      g= 8.87                    ! gravite (m.s-2) ~8.87
+      mugaz=43.44                ! Masse molaire de l'atm (g.mol-1) ~43.44
+! ADAPTATION GCM POUR CP(T)
+! VENUS: Cp(T) = cpp*(T/T0)^nu 
+! avec T0=460. et nu=0.35
+      cpp=1.0e3
+!     cpp=9.0e2      ! version constante
+      cppdyn=cpp
+      r= 8.314511E+0 *1000.E+0/mugaz
+      rcp= r/cpp
+
+c-----------------------------------------------------------------------
+c   Initialisation des traceurs
+c   ---------------------------
+c  Choix du nombre de traceurs et du schema pour l'advection
+c  dans fichier traceur.def
+      call infotrac_init
+
+c Allocation de la tableau q : champs advectes   
+      allocate(q(llm,nqtot))
+      allocate(dq(llm,nqtot))
+
+c ------------------------------------------------------
+c  Lecture des parametres dans "rcm1d.def" 
+c ------------------------------------------------------
+
+c   Opening parameters file "rcm1d.def"
+c   ---------------------------------------
+      unit =97
+      OPEN(unit,file='rcm1d.def',status='old',form='formatted'
+     .     ,iostat=ierr)
+
+      IF(ierr.ne.0) THEN
+        write(*,*) 'Problem to open "rcm1d.def'
+        write(*,*) 'Is it there ?'
+        stop
+      END IF
+
+c  Date et heure locale du debut du run
+c  ------------------------------------
+c    Date (en sols depuis le solstice de printemps) du debut du run
+      day0 = 0
+      PRINT *,'date de depart ?'
+      READ(unit,*) day0
+      day=REAL(day0)
+      PRINT *,day0
+c  Heure de demarrage
+      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
+      READ(unit,*) time
+      time=time/24.E+0
+
+c  Discretisation (Definition de la grille et des pas de temps)
+c  --------------
+c
+      nlayer=llm
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+      PRINT *,'nombre de pas de temps par jour ?'
+      READ(unit,*) day_step
+      print*,day_step
+
+c     PRINT *,'nombre d appel au rayonnement par jour ?'
+c     READ(unit,*) nbapp_rad
+c     print*,nbapp_rad
+c LU DANS PHYSIQ.DEF...
+      nbapp_rad = 1000.
+
+      PRINT *,'nombre de jours simules ?'
+      READ(unit,*) ndt
+      print*,ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+      dtime=dtphys
+
+c Pression de surface sur la planete
+c ------------------------------------
+c
+      PRINT *,'pression au sol'
+      READ(unit,*) psurf
+      PRINT *,psurf
+c Pression de reference  ! voir dyn3d/etat0_venus
+c     pa     =  5.e4 
+      pa     =  1.e6 
+      preff  = 9.2e6 ! 92 bars
+c     preff  = psurf
+ 
+c  latitude/longitude 
+c  -------------------
+      PRINT *,'latitude en degres ?'
+      READ(unit,*) lati(1)
+      PRINT *,lati(1)
+      long(1)=0.E+0
+
+c   Initialisation speciales "physiq"
+c   ---------------------------------
+
+      CALL init_phys_lmdz(iim,jjm,llm,1,(/1/))
+      call initcomgeomphy
+      call ini_cpdet
+
+c   la surface de chaque maille est inutile en 1D --->
+      area(1)=1.E+0
+c de meme ?
+      cufi(1)=1.E+0
+      cvfi(1)=1.E+0
+
+c   le geopotentiel au sol est inutile en 1D car tout est controle
+c   par la pression de surface --->
+      phisfi(1)=0.E+0
+
+      CALL iniphysiq(1,1,llm,daysec,day0,dtphys,
+     .            lati,long,area,cufi,cvfi,rad,g,r,cpp,1)
+
+c   Initialisation pour prendre en compte les vents en 1-D
+c   ------------------------------------------------------
+ 
+c    vent geostrophique
+      PRINT *,'composante vers l est du vent geostrophique (U) ?'
+      READ(unit,*) gru
+      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
+      READ(unit,*) grv
+
+c     Initialisation des vents  au premier pas de temps
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c  calcul des pressions et altitudes en utilisant les niveaux sigma
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates  (hybrids)
+c    """"""""""""""""""""
+      CALL  disvert_noterre
+      
+c     Calcul au milieu des couches : Vient de la version Mars
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     C'est fait de la meme facon dans disvert
+
+      DO l = 1, llm
+       aps(l) =  0.5 *( ap(l) +ap(l+1))
+       bps(l) =  0.5 *( bp(l) +bp(l+1))
+      ENDDO
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+        pk(ilayer)  =cpp*(play(ilayer)/preff)**rcp
+c       write(120,*) ilayer,plev(ilayer),play(ilayer)
+      ENDDO
+c     write(120,*) nlevel,plev(nlevel)
+c     stop
+      
+      pks=cpp*(psurf/preff)**rcp
+
+c  init des variables pour phyredem
+c  --------------------------------
+      call phys_state_var_init
+
+c  profil de temperature et altitude au premier appel
+c  --------------------------------------------------
+
+c modif par rapport a Mars: 
+c   on envoie dz/T=-log(play/psurf)*r/g dans profile
+      tmp1(0)=0.0
+      tmp1(1)= -log(play(1)/psurf)*r/g
+      DO ilayer=2,nlayer
+        tmp1(ilayer)=-log(play(ilayer)/play(ilayer-1))*r/g
+      ENDDO
+      call profile(unit,nlayer+1,tmp1,tmp2)
+      CLOSE(unit)
+
+      print*,"               Pression        Altitude     Temperature"
+      ilayer=1
+      ftsol(1)=tmp2(0)
+       temp(1)=tmp2(1)
+       zlay(1)=tmp2(1)*tmp1(1)
+      print*,"           0",ftsol(1)
+      print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      DO ilayer=2,nlayer
+        temp(ilayer)=tmp2(ilayer)
+        zlay(ilayer)=zlay(ilayer-1)+tmp2(ilayer)*tmp1(ilayer)
+        print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
+      ENDDO
+
+      allocate(tmoy(llm))
+      tmoy(:)=temp(:)
+      
+c     temperature du sous-sol
+c     ~~~~~~~~~~~~~~~~~~~~~~~
+      DO isoil=1,nsoil
+         ftsoil(1,isoil)=ftsol(1)
+      ENDDO
+
+c    Initialisation des traceurs
+c    ---------------------------
+
+      DO iq=1,nqtot
+        DO ilayer=1,nlayer
+           q(ilayer,iq) = 0.
+        ENDDO
+      ENDDO
+
+c FULL CHEMISTRY !! AJOUTER INIT AURELIEN...
+C Faudrait lire les cles avant pour mettre ca en option....
+c ou alors mettre ca dans physiq
+
+c    Initialisation des parametres d'oro
+c    -----------------------------------
+
+      zmea(1) = 0.
+      zstd(1) = 0.
+      zsig(1) = 0.
+      zgam(1) = 0.
+      zthe(1) = 0.
+      zpic(1) = 0.
+      zval(1) = 0.
+
+c  Initialisation albedo 
+c  ----------------------
+
+      falbe(1)=0.1
+
+c  Ecriture de "startphy.nc"
+c  -------------------------
+c  (Ce fichier sera aussitot relu au premier
+c   appel de "physiq", mais il est necessaire pour passer
+c   les variables purement physiques a "physiq"...
+
+      solsw(1)    = 0.
+      sollw(1)    = 0.
+      fder(1)      = 0.
+      radsol(1)   = 0.
+     
+      radpas      = NINT(1.*day_step/nbapp_rad)
+      soil_model  = .true.
+
+      call phyredem("startphy.nc")
+
+c  deallocation des variables phyredem
+c  -----------------------------------
+      call phys_state_var_end
+
+c=======================================================================
+c  BOUCLE TEMPORELLE DU MODELE 1D 
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+        IF (idt.eq.ndt) then
+         lastcall=.true.
+c toujours nulle dans le cas de Venus, pour l'instant...
+         zls = 0.0
+c        write(103,*) 'Ls=',zls*180./pi
+c        write(103,*) 'Lat=', lati(1)
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(103,*) 'RunEnd - Atmos. Temp. File'
+c        write(104,*) 'Ls=',zls*180./pi
+c        write(104,*) 'Lat=', lati(1)
+c        write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c    calcul du geopotentiel 
+c     ~~~~~~~~~~~~~~~~~~~~~
+! ADAPTATION GCM POUR CP(T)
+      DO ilayer=1,nlayer
+        s(ilayer)=(play(ilayer)/psurf)**rcp
+      ENDDO
+      phi(1)=cpp*temp(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &     cpp*(temp(ilayer-1)/s(ilayer-1)+temp(ilayer)/s(ilayer))*0.5
+     &        *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       appel de la physique
+c       --------------------
+
+      CALL physiq (1,llm,nqtot,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,pk,phi,phisfi,
+     ,     presnivs,
+     ,     u,v,temp,q,  
+     ,     w,
+C - sorties
+     s     du,dv,dtemp,dq,dpsurf)
+
+c     print*,"DT APRES PHYSIQ=",day,time
+c     print*,dtemp
+c     print*,temp
+c     print*," "
+c     stop
+
+c       evolution du vent : modele 1D
+c       -----------------------------
+ 
+c       la physique calcule les derivees temporelles de u et v.
+c       Pas de coriolis 
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c      
+c       Calcul du temps au pas de temps suivant
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       calcul des vitesses et temperature au pas de temps suivant
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       calcul des pressions au pas de temps suivant
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+      ENDDO   ! fin de la boucle temporelle
+
+c    ========================================================
+c    GESTION DES SORTIE
+c    ========================================================
+
+        print*,"Temperature finale:"
+        print*,temp
+        
+c stabilite
+      DO ilayer=1,nlayer
+        zlay(ilayer) = phi(ilayer)/g/1000.  !en km
+      ENDDO
+      DO ilayer=2,nlayer
+        tmp1(ilayer) =
+     .    (temp(ilayer)-temp(ilayer-1))/(zlay(ilayer)-zlay(ilayer-1)) 
+     .   + 1000.*g/cpp
+      ENDDO
+
+      OPEN(11,file='profile.new')
+      DO ilayer=1,nlayer
+        write (11,*) zlay(ilayer),temp(ilayer),tmp1(ilayer)
+      ENDDO
+
+c    ========================================================
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+
+!#include "../dyn3d_common/disvert_noterre.F"
+!#include "../dyn3d/abort_gcm.F"
+
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/temps.h
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/temps.h	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/temps.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/temps.h
Index: /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/write_field.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/write_field.F90	(revision 1403)
+++ /trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/write_field.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d_common/write_field.F90
Index: unk/LMDZ.VENUS/libf/phyvenus/ini_archive.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/ini_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,355 +1,0 @@
-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: unk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/iniphysiq.F90	(revision 1402)
+++ 	(revision )
@@ -1,195 +1,0 @@
-
-! $Id: iniphysiq.F90 2225 2015-03-11 14:55:23Z emillour $
-
-
-SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
-                     rlatu,rlonv,aire,cu,cv,                             &
-                     prad,pg,pr,pcpp,iflag_phys)
-  USE dimphy, ONLY: klev ! number of atmospheric levels
-  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
-                                        ! (on full grid)
-  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
-                                klon_omp_begin, & ! start index of local omp subgrid
-                                klon_omp_end, & ! end index of local omp subgrid
-                                klon_mpi_begin ! start indes of columns (on local mpi grid)
-  USE comgeomphy, ONLY: initcomgeomphy, &
-                        airephy, & ! physics grid area (m2)
-                        cuphy, & ! cu coeff. (u_covariant = cu * u)
-                        cvphy, & ! cv coeff. (v_covariant = cv * v)
-                        rlond, & ! longitudes
-                        rlatd ! latitudes
-  IMPLICIT NONE
-
-  ! =======================================================================
-  ! Initialisation of the physical constants and some positional and
-  ! geometrical arrays for the physics
-  ! =======================================================================
-
-  include "YOMCST.h"
-  include "iniprint.h"
-
-  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) :: nlayer ! number of atmospheric layers
-  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
-  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
-  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
-  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
-  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
-  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
-  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! 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 :: ibegin, iend, offset
-  INTEGER :: i,j
-  CHARACTER (LEN=20) :: modname = 'iniphysiq'
-  CHARACTER (LEN=80) :: abort_message
-  REAL :: total_area_phy, total_area_dyn
-
-
-  ! global array, on full physics grid:
-  REAL,ALLOCATABLE :: latfi(:)
-  REAL,ALLOCATABLE :: lonfi(:)
-  REAL,ALLOCATABLE :: cufi(:)
-  REAL,ALLOCATABLE :: cvfi(:)
-  REAL,ALLOCATABLE :: airefi(:)
-
-  IF (nlayer/=klev) THEN
-    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)
-  END IF
-
-  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-  
-  ! Generate global arrays on full physics grid
-  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
-  ALLOCATE(airefi(klon_glo))
-
-  IF (klon_glo>1) THEN ! general case
-    ! North pole
-    latfi(1)=rlatu(1)
-    lonfi(1)=0.
-    cufi(1) = cu(1)
-    cvfi(1) = cv(1)
-    DO j=2,jjm
-      DO i=1,iim
-        latfi((j-2)*iim+1+i)= rlatu(j)
-        lonfi((j-2)*iim+1+i)= rlonv(i)
-        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
-        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
-      ENDDO
-    ENDDO
-    ! South pole
-    latfi(klon_glo)= rlatu(jjm+1)
-    lonfi(klon_glo)= 0.
-    cufi(klon_glo) = cu((iim+1)*jjm+1)
-    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
-
-    ! build airefi(), mesh area on physics grid
-    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
-    ! Poles are single points on physics grid
-    airefi(1)=sum(aire(1:iim,1))
-    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
-
-    ! Sanity check: do total planet area match between physics and dynamics?
-    total_area_dyn=sum(aire(1:iim,1:jjm+1))
-    total_area_phy=sum(airefi(1:klon_glo))
-    IF (total_area_dyn/=total_area_phy) THEN
-      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
-      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
-      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
-      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
-        ! stop here if the relative difference is more than 0.001%
-        abort_message = 'planet total surface discrepancy'
-        CALL abort_gcm(modname, abort_message, 1)
-      ENDIF
-    ENDIF
-  ELSE ! klon_glo==1, running the 1D model
-    ! just copy over input values
-    latfi(1)=rlatu(1)
-    lonfi(1)=rlonv(1)
-    cufi(1)=cu(1)
-    cvfi(1)=cv(1)
-    airefi(1)=aire(1,1)
-  ENDIF ! of IF (klon_glo>1)
-
-!$OMP PARALLEL 
-  ! Now generate local lon/lat/cu/cv/area arrays
-  CALL initcomgeomphy
-
-  offset = klon_mpi_begin - 1
-  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
-  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
-  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
-  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
-  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
-
-  ! Initialize some physical constants
-  call suphec
-
-!$OMP END PARALLEL
-
-  ! check that physical constants set in 'suphec' are coherent
-  ! with values set in the dynamics:
-  IF (rday/=punjours) THEN
-    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
-    WRITE (lunout, *) '  in the dynamics punjours=', punjours
-    WRITE (lunout, *) '   but in the physics RDAY=', rday
-    IF (abs(rday-punjours)>0.01*punjours) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'length of day discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-
-  IF (rg/=pg) THEN
-    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pg=', pg
-    WRITE (lunout, *) '  but in the physics RG=', rg
-    IF (abs(rg-pg)>0.01*pg) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'gravity discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (ra/=prad) THEN
-    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
-    WRITE (lunout, *) '   in the dynamics prad=', prad
-    WRITE (lunout, *) '  but in the physics RA=', ra
-    IF (abs(ra-prad)>0.01*prad) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'planet radius discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rd/=pr) THEN
-    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pr=', pr
-    WRITE (lunout, *) '  but in the physics RD=', rd
-    IF (abs(rd-pr)>0.01*pr) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'reduced gas constant discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-  IF (rcpd/=pcpp) THEN
-    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
-    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
-    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
-    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
-        ! stop here if the relative difference is more than 1%
-      abort_message = 'specific heat discrepancy'
-      CALL abort_gcm(modname, abort_message, 1)
-    END IF
-  END IF
-
-END SUBROUTINE iniphysiq
Index: unk/LMDZ.VENUS/libf/phyvenus/mod_grid_phy_lmdz.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_grid_phy_lmdz.F90	(revision 1402)
+++ 	(revision )
@@ -1,447 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_grid_phy_lmdz
-
-  PUBLIC
-  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
-             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
-
-  INTEGER,SAVE :: nbp_lon  ! == iim
-  INTEGER,SAVE :: nbp_lat  ! == jjmp1
-  INTEGER,SAVE :: nbp_lev  ! == llm
-  INTEGER,SAVE :: klon_glo
-
-  INTERFACE grid1dTo2d_glo
-    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
-                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
-		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
-   END INTERFACE 
-
-   INTERFACE grid2dTo1d_glo
-    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
-                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
-		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
-   END INTERFACE 
- 
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
-  IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjp1
-  INTEGER, INTENT(in) :: llm
-  
-    nbp_lon=iim
-    nbp_lat=jjp1
-    nbp_lev=llm
-    klon_glo=(iim*jjp1)-2*(iim-1)
-  
-  END SUBROUTINE init_grid_phy_lmdz
-  
-  
-  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_i
-  
-
-  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_i1
-
-  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_i2
-  
-  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_i3
-
-
-  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_r
-  
-
-  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_r1
-
-  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_r2
-  
-  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_l
-  
-
-  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_l1
-
-  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_l2
-  
-  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_l3  
-  
-    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_i
-  
-
-  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_i1
-
-  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_i2
-  
-  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_r
-  
-
-  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_r1
-
-  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_r2
-  
-  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_r3
-
-
-
-  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_l
-  
-
-  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_l1
-
-  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_l2
-  
-  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_l3
-
-!---------------------------------------------------------------- 
-!  fonctions generiques (privees)
-!---------------------------------------------------------------- 
-  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_igen   
-
-
-  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-   
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_rgen   
-
-  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_lgen     
-  
-  
-  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_igen   
-  
-  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_rgen 
-    
-  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_lgen   
-
-END MODULE mod_grid_phy_lmdz
Index: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_mpi_data.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_mpi_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,203 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_mpi_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1902 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_omp_data.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_omp_data.F90	(revision 1402)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_omp_transfert.F90	(revision 1402)
+++ 	(revision )
@@ -1,1057 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_para.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,113 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_transfert_para.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/mod_phys_lmdz_transfert_para.F90	(revision 1402)
+++ 	(revision )
@@ -1,1275 +1,0 @@
-!
-!$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: unk/LMDZ.VENUS/libf/phyvenus/newstart.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/newstart.F	(revision 1402)
+++ 	(revision )
@@ -1,1176 +1,0 @@
-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
-      use exner_hyb_m, only: exner_hyb
-      use exner_milieu_m, only: exner_milieu
-
-      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),fder(ngridmx)
-      real sollwdown(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),fderS(ip1jmp1)
-      real sollwdownS(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 :: fderold
-      real, dimension(:,:),   allocatable :: dlwold,sollwdownold
-      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,razvitu,razvitv 
-      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(fderold(imold+1,jmold+1))
-      allocate(sollwdownold(imold+1,jmold+1),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, "fder", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <fder> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,fderold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,fderold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <fder>"
-         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, "sollwdown", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Le champ <sollwdown> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,sollwdownold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,sollwdownold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Lecture echouee pour <sollwdown>"
-         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)
-
-        print*,zmeaold(2,1:10)
-
-       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 (fderold,fderS,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iip1,jjp1,ngridmx,fderS,fder)
-
-      call interp_horiz (dlwold,dlwS,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iip1,jjp1,ngridmx,dlwS,dlw)
-
-      call interp_horiz (sollwdownold,sollwdownS,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iip1,jjp1,ngridmx,sollwdownS,sollwdown)
-
-      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, pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
-           CALL exner_milieu( ip1jmp1, ps, p3d, 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,:,:)
-
-! RESETING U TO 0: may be done through run.def
-       razvitu = . FALSE .
-       CALL getin('razvitu',razvitu)
-       razvitv = . FALSE .
-       CALL getin('razvitv',razvitv)
-
-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)
-! Reseting u=0
-      if (razvitu) then
-           unat(:,:,:) = 0.
-      endif
-      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
-! Reseting v=0
-      if (razvitv) then
-           vnat(:,:,:) = 0.
-      endif
-      write (*,*) 'vnat ', vnat (1,2,1)    ! INFO
-      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,fder,dlw,
-     .           sollwdown,radsol,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,
-     .           t_fi)
-
-      print*,"restartphy OK"
-
-      end
Index: unk/LMDZ.VENUS/libf/phyvenus/rcm1d.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/rcm1d.F	(revision 1402)
+++ 	(revision )
@@ -1,477 +1,0 @@
-      PROGRAM rcm1d
-      
-      USE infotrac
-      use control_mod
-      use comgeomphy
-      USE phys_state_var_mod
-      use chemparam_mod
-      use cpdet_mod, only: ini_cpdet
-      use moyzon_mod, only: tmoy
-
-      IMPLICIT NONE
-
-c=======================================================================
-c   subject:
-c   --------
-c   PROGRAM useful to run physical part of the venusian GCM in a 1D column
-c       
-c Can be compiled with a command like (e.g. for 50 layers)
-c  "makelmdz -p venus -d 50 rcm1d"
-
-c It requires the files "rcm1d.def" "physiq.def"
-c      and a file describing the sigma layers (e.g. "z2sig.def")
-c
-c   author: Frederic Hourdin, R.Fournier,F.Forget (original Mars version)
-c   ------- Sebastien Lebonnois (Venus version)
-c   
-c=======================================================================
-
-#include "dimensions.h"
-#include "dimsoil.h"
-#include "comcstfi.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "logic.h"
-#include "clesphys.h"
-#include "iniprint.h"
-#include "tabcontrol.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unit           ! unite de lecture de "rcm1d.def"
-      INTEGER unitstart      ! unite d'ecriture de "startphy.nc"
-      INTEGER nlayer,nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day              ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(llm)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(llm+1) ! intermediate pressure levels (pa)
-      REAL psurf      
-      REAL u(llm),v(llm)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(llm)   ! temperature at the middle of the layers
-      REAL,allocatable :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
-      REAL zlay(llm)   ! altitude estimee dans les couches (km)
-      REAL long(1),lati(1),area(1)
-      REAL cufi(1),cvfi(1)
-      REAL phisfi(1)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(llm),dv(llm),dtemp(llm)
-      REAL dudyn(llm),dvdyn(llm),dtempdyn(llm)
-      REAL dpsurf    
-      REAL,allocatable :: dq(:,:)
-
-c   Various intermediate variables
-      REAL zls
-      REAL phi(llm),s(llm)
-      REAL pk(llm),pks, w(llm)
-      INTEGER l, ierr, aslun
-      REAL tmp1(0:llm),tmp2(0:llm)                        
-
-      character*2 str2
-
-c normalement dans dyn3d/comconst.h
-      COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
-      REAL cppdyn,nu_venus,t0_venus
-      real pi
-
-c=======================================================================
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-
-      lunout = 6
-
-c ------------------------------------------------------
-c  Constantes prescrites ICI
-c ------------------------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Constante de la Planete Venus
-c     -----------------------------
-      planet_type = "venus"
-      rad=6051300.               ! rayon de Venus (m)  ~6051300 m
-      daysec= 1.0087e7           ! duree du sol (s)  ~1.e7 s
-      omeg=4.*asin(1.)/19.4141e6 ! vitesse de rotation (rad.s-1)
-      g= 8.87                    ! gravite (m.s-2) ~8.87
-      mugaz=43.44                ! Masse molaire de l'atm (g.mol-1) ~43.44
-! ADAPTATION GCM POUR CP(T)
-! VENUS: Cp(T) = cpp*(T/T0)^nu 
-! avec T0=460. et nu=0.35
-      cpp=1.0e3
-!     cpp=9.0e2      ! version constante
-      cppdyn=cpp
-      r= 8.314511E+0 *1000.E+0/mugaz
-      rcp= r/cpp
-
-c-----------------------------------------------------------------------
-c   Initialisation des traceurs
-c   ---------------------------
-c  Choix du nombre de traceurs et du schema pour l'advection
-c  dans fichier traceur.def
-      call infotrac_init
-
-c Allocation de la tableau q : champs advectes   
-      allocate(q(llm,nqtot))
-      allocate(dq(llm,nqtot))
-
-c ------------------------------------------------------
-c  Lecture des parametres dans "rcm1d.def" 
-c ------------------------------------------------------
-
-c   Opening parameters file "rcm1d.def"
-c   ---------------------------------------
-      unit =97
-      OPEN(unit,file='rcm1d.def',status='old',form='formatted'
-     .     ,iostat=ierr)
-
-      IF(ierr.ne.0) THEN
-        write(*,*) 'Problem to open "rcm1d.def'
-        write(*,*) 'Is it there ?'
-        stop
-      END IF
-
-c  Date et heure locale du debut du run
-c  ------------------------------------
-c    Date (en sols depuis le solstice de printemps) du debut du run
-      day0 = 0
-      PRINT *,'date de depart ?'
-      READ(unit,*) day0
-      day=REAL(day0)
-      PRINT *,day0
-c  Heure de demarrage
-      PRINT *,'heure de debut de simulation (entre 0 et 24) ?'
-      READ(unit,*) time
-      time=time/24.E+0
-
-c  Discretisation (Definition de la grille et des pas de temps)
-c  --------------
-c
-      nlayer=llm
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-      PRINT *,'nombre de pas de temps par jour ?'
-      READ(unit,*) day_step
-      print*,day_step
-
-c     PRINT *,'nombre d appel au rayonnement par jour ?'
-c     READ(unit,*) nbapp_rad
-c     print*,nbapp_rad
-c LU DANS PHYSIQ.DEF...
-      nbapp_rad = 1000.
-
-      PRINT *,'nombre de jours simules ?'
-      READ(unit,*) ndt
-      print*,ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-      dtime=dtphys
-
-c Pression de surface sur la planete
-c ------------------------------------
-c
-      PRINT *,'pression au sol'
-      READ(unit,*) psurf
-      PRINT *,psurf
-c Pression de reference  ! voir dyn3d/etat0_venus
-c     pa     =  5.e4 
-      pa     =  1.e6 
-      preff  = 9.2e6 ! 92 bars
-c     preff  = psurf
- 
-c  latitude/longitude 
-c  -------------------
-      PRINT *,'latitude en degres ?'
-      READ(unit,*) lati(1)
-      PRINT *,lati(1)
-      long(1)=0.E+0
-
-c   Initialisation speciales "physiq"
-c   ---------------------------------
-
-      CALL init_phys_lmdz(iim,jjm,llm,1,(/1/))
-      call initcomgeomphy
-      call ini_cpdet
-
-c   la surface de chaque maille est inutile en 1D --->
-      area(1)=1.E+0
-c de meme ?
-      cufi(1)=1.E+0
-      cvfi(1)=1.E+0
-
-c   le geopotentiel au sol est inutile en 1D car tout est controle
-c   par la pression de surface --->
-      phisfi(1)=0.E+0
-
-      CALL iniphysiq(1,1,llm,daysec,day0,dtphys,
-     .            lati,long,area,cufi,cvfi,rad,g,r,cpp,1)
-
-c   Initialisation pour prendre en compte les vents en 1-D
-c   ------------------------------------------------------
- 
-c    vent geostrophique
-      PRINT *,'composante vers l est du vent geostrophique (U) ?'
-      READ(unit,*) gru
-      PRINT *,'composante vers le nord du vent geostrophique (V) ?'
-      READ(unit,*) grv
-
-c     Initialisation des vents  au premier pas de temps
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c  calcul des pressions et altitudes en utilisant les niveaux sigma
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates  (hybrids)
-c    """"""""""""""""""""
-      CALL  disvert_noterre
-      
-c     Calcul au milieu des couches : Vient de la version Mars
-c     WARNING : le choix de placer le milieu des couches au niveau de
-c     pression intermédiaire est arbitraire et pourrait etre modifié.
-c     C'est fait de la meme facon dans disvert
-
-      DO l = 1, llm
-       aps(l) =  0.5 *( ap(l) +ap(l+1))
-       bps(l) =  0.5 *( bp(l) +bp(l+1))
-      ENDDO
-
-      DO ilevel=1,nlevel
-        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-        pk(ilayer)  =cpp*(play(ilayer)/preff)**rcp
-c       write(120,*) ilayer,plev(ilayer),play(ilayer)
-      ENDDO
-c     write(120,*) nlevel,plev(nlevel)
-c     stop
-      
-      pks=cpp*(psurf/preff)**rcp
-
-c  init des variables pour phyredem
-c  --------------------------------
-      call phys_state_var_init
-
-c  profil de temperature et altitude au premier appel
-c  --------------------------------------------------
-
-c modif par rapport a Mars: 
-c   on envoie dz/T=-log(play/psurf)*r/g dans profile
-      tmp1(0)=0.0
-      tmp1(1)= -log(play(1)/psurf)*r/g
-      DO ilayer=2,nlayer
-        tmp1(ilayer)=-log(play(ilayer)/play(ilayer-1))*r/g
-      ENDDO
-      call profile(unit,nlayer+1,tmp1,tmp2)
-      CLOSE(unit)
-
-      print*,"               Pression        Altitude     Temperature"
-      ilayer=1
-      ftsol(1)=tmp2(0)
-       temp(1)=tmp2(1)
-       zlay(1)=tmp2(1)*tmp1(1)
-      print*,"           0",ftsol(1)
-      print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
-      DO ilayer=2,nlayer
-        temp(ilayer)=tmp2(ilayer)
-        zlay(ilayer)=zlay(ilayer-1)+tmp2(ilayer)*tmp1(ilayer)
-        print*,ilayer,play(ilayer),zlay(ilayer),temp(ilayer)
-      ENDDO
-
-      allocate(tmoy(llm))
-      tmoy(:)=temp(:)
-      
-c     temperature du sous-sol
-c     ~~~~~~~~~~~~~~~~~~~~~~~
-      DO isoil=1,nsoil
-         ftsoil(1,isoil)=ftsol(1)
-      ENDDO
-
-c    Initialisation des traceurs
-c    ---------------------------
-
-      DO iq=1,nqtot
-        DO ilayer=1,nlayer
-           q(ilayer,iq) = 0.
-        ENDDO
-      ENDDO
-
-c FULL CHEMISTRY !! AJOUTER INIT AURELIEN...
-C Faudrait lire les cles avant pour mettre ca en option....
-c ou alors mettre ca dans physiq
-
-c    Initialisation des parametres d'oro
-c    -----------------------------------
-
-      zmea(1) = 0.
-      zstd(1) = 0.
-      zsig(1) = 0.
-      zgam(1) = 0.
-      zthe(1) = 0.
-      zpic(1) = 0.
-      zval(1) = 0.
-
-c  Initialisation albedo 
-c  ----------------------
-
-      falbe(1)=0.1
-
-c  Ecriture de "startphy.nc"
-c  -------------------------
-c  (Ce fichier sera aussitot relu au premier
-c   appel de "physiq", mais il est necessaire pour passer
-c   les variables purement physiques a "physiq"...
-
-      solsw(1)    = 0.
-      sollw(1)    = 0.
-      fder(1)      = 0.
-      radsol(1)   = 0.
-     
-      radpas      = NINT(1.*day_step/nbapp_rad)
-      soil_model  = .true.
-
-      call phyredem("startphy.nc")
-
-c  deallocation des variables phyredem
-c  -----------------------------------
-      call phys_state_var_end
-
-c=======================================================================
-c  BOUCLE TEMPORELLE DU MODELE 1D 
-c=======================================================================
-c
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-        IF (idt.eq.ndt) then
-         lastcall=.true.
-c toujours nulle dans le cas de Venus, pour l'instant...
-         zls = 0.0
-c        write(103,*) 'Ls=',zls*180./pi
-c        write(103,*) 'Lat=', lati(1)
-c        write(103,*) 'RunEnd - Atmos. Temp. File'
-c        write(103,*) 'RunEnd - Atmos. Temp. File'
-c        write(104,*) 'Ls=',zls*180./pi
-c        write(104,*) 'Lat=', lati(1)
-c        write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c    calcul du geopotentiel 
-c     ~~~~~~~~~~~~~~~~~~~~~
-! ADAPTATION GCM POUR CP(T)
-      DO ilayer=1,nlayer
-        s(ilayer)=(play(ilayer)/psurf)**rcp
-      ENDDO
-      phi(1)=cpp*temp(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &     cpp*(temp(ilayer-1)/s(ilayer-1)+temp(ilayer)/s(ilayer))*0.5
-     &        *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       appel de la physique
-c       --------------------
-
-      CALL physiq (1,llm,nqtot,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,pk,phi,phisfi,
-     ,     presnivs,
-     ,     u,v,temp,q,  
-     ,     w,
-C - sorties
-     s     du,dv,dtemp,dq,dpsurf)
-
-c     print*,"DT APRES PHYSIQ=",day,time
-c     print*,dtemp
-c     print*,temp
-c     print*," "
-c     stop
-
-c       evolution du vent : modele 1D
-c       -----------------------------
- 
-c       la physique calcule les derivees temporelles de u et v.
-c       Pas de coriolis 
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c      
-c       Calcul du temps au pas de temps suivant
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       calcul des vitesses et temperature au pas de temps suivant
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       calcul des pressions au pas de temps suivant
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! evolution de la pression de surface
-           DO ilevel=1,nlevel
-             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-      ENDDO   ! fin de la boucle temporelle
-
-c    ========================================================
-c    GESTION DES SORTIE
-c    ========================================================
-
-        print*,"Temperature finale:"
-        print*,temp
-        
-c stabilite
-      DO ilayer=1,nlayer
-        zlay(ilayer) = phi(ilayer)/g/1000.  !en km
-      ENDDO
-      DO ilayer=2,nlayer
-        tmp1(ilayer) =
-     .    (temp(ilayer)-temp(ilayer-1))/(zlay(ilayer)-zlay(ilayer-1)) 
-     .   + 1000.*g/cpp
-      ENDDO
-
-      OPEN(11,file='profile.new')
-      DO ilayer=1,nlayer
-        write (11,*) zlay(ilayer),temp(ilayer),tmp1(ilayer)
-      ENDDO
-
-c    ========================================================
-      END
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d_common/disvert_noterre.F"
-#include "../dyn3d/abort_gcm.F"
-
Index: unk/LMDZ.VENUS/libf/phyvenus/readstart.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/readstart.F	(revision 1402)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $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: unk/LMDZ.VENUS/libf/phyvenus/start2archive.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/start2archive.F	(revision 1402)
+++ 	(revision )
@@ -1,324 +1,0 @@
-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,ini_cpdet
-      use exner_hyb_m, only: exner_hyb
-      use exner_milieu_m, only: exner_milieu
-
-      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),fder(ngridmx)
-      real sollwdown(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),fderS(ip1jmp1)
-      real dlwS(ip1jmp1),sollwdownS(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,
-     .       fder,dlw,sollwdown,radsol,
-     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,
-     .       tab_cntrl_fi)
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL conf_gcm( 99, .TRUE. )
-      call iniconst
-      call inigeom
-      call inifilr
-      call ini_cpdet
-
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-         if (disvert_type==1) then
-           CALL exner_hyb(  ip1jmp1, ps, p3d, pks, pk, pkf )
-         else ! we assume that we are in the disvert_type==2 case
-           CALL exner_milieu( ip1jmp1, ps, p3d, 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,fder,fderS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,dlw,dlwS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sollwdown,sollwdownS)
-      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 déjà...'
-	 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,'fder','derive','?',2,fderS)
-      call write_archive(nid,'dlw','LW derive','?',2,dlwS)
-      call write_archive(nid,'sollwdown',
-     .             'LW dwn flux at surface','?',2,sollwdownS)
-      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: unk/LMDZ.VENUS/libf/phyvenus/startvar.F90
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/startvar.F90	(revision 1402)
+++ 	(revision )
@@ -1,770 +1,0 @@
-!
-! $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: unk/LMDZ.VENUS/libf/phyvenus/write_archive.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/write_archive.F	(revision 1402)
+++ 	(revision )
@@ -1,197 +1,0 @@
-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: unk/LMDZ.VENUS/libf/phyvenus/writerestart.F
===================================================================
--- /trunk/LMDZ.VENUS/libf/phyvenus/writerestart.F	(revision 1402)
+++ 	(revision )
@@ -1,495 +1,0 @@
-      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
-
