Index: trunk/LMDZ.MARS/libf/phymars/datareadnc.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/datareadnc.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/ini_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/ini_archive.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/lect_start_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/lect_start_archive.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/newstart.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/newstart.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/start2archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/start2archive.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/testphys1d.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/testphys1d.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/write_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/write_archive.F	(revision 1395)
+++ 	(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: trunk/LMDZ.MARS/libf/phymars/xvik.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/xvik.F	(revision 1395)
+++ 	(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
