Index: trunk/LMDZ.MARS/libf/dyn3d/calfis.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/calfis.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/calfis.F	(revision 1130)
@@ -71,5 +71,5 @@
 #include "comvert.h"
 #include "comgeom2.h"
-#include "control.h"
+!#include "control.h"
 
 c    Arguments :
@@ -167,25 +167,25 @@
 
 c
-      IF (firstcal) THEN
-         latfi(1)=rlatu(1)
-         lonfi(1)=0.
-         DO j=2,jjm
-            DO i=1,iim
-               latfi((j-2)*iim+1+i)= rlatu(j)
-               lonfi((j-2)*iim+1+i)= rlonv(i)
-            ENDDO
-         ENDDO
-         latfi(ngridmx)= rlatu(jjp1)
-         lonfi(ngridmx)= 0.
-         
-         ! build airefi(), mesh area on physics grid
-         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-         ! Poles are single points on physics grid
-         airefi(1)=airefi(1)*iim
-         airefi(ngridmx)=airefi(ngridmx)*iim
-
-         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
-     .                latfi,lonfi,airefi,rad,g,r,cpp)
-      ENDIF
+!      IF (firstcal) THEN
+!         latfi(1)=rlatu(1)
+!         lonfi(1)=0.
+!         DO j=2,jjm
+!            DO i=1,iim
+!               latfi((j-2)*iim+1+i)= rlatu(j)
+!               lonfi((j-2)*iim+1+i)= rlonv(i)
+!            ENDDO
+!         ENDDO
+!         latfi(ngridmx)= rlatu(jjp1)
+!         lonfi(ngridmx)= 0.
+!         
+!         ! build airefi(), mesh area on physics grid
+!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+!         ! Poles are single points on physics grid
+!         airefi(1)=airefi(1)*iim
+!         airefi(ngridmx)=airefi(ngridmx)*iim
+!
+!         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
+!     .                latfi,lonfi,airefi,rad,g,r,cpp)
+!      ENDIF
 
 c
Index: trunk/LMDZ.MARS/libf/dyn3d/control.h
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/control.h	(revision 1127)
+++ 	(revision )
@@ -1,25 +1,0 @@
-!-----------------------------------------------------------------------
-! INCLUDE 'control.h'
-! For Fortran 77/Fortran 90 compliance always use line continuation
-! symbols '&' in columns 73 and 6
-!
-
-      COMMON/control_i/ndynstep,day_step,                               &
-     &              iperiod,iconser,idissip,iphysiq ,                   &
-     &              anneeref,ecritstart
-      COMMON/control_r/periodav,ecritphy,nday_r,timestart
-
-      INTEGER ndynstep ! # of dynamical time steps to run (if negative or not specified in run.def, nday_r is used instead)
-      INTEGER day_step ! # of dynamical time steps per day
-      INTEGER iperiod  ! make a Matsuno step before avery iperiod-1 LF steps
-      INTEGER iconser !
-      INTEGER idissip ! apply dissipation every idissip dynamical step
-      INTEGER iphysiq ! call physics every iphysiq dynamical steps
-      INTEGER anneeref ! reference year # ! not used
-      REAL periodav
-      REAL ecritphy ! output data in "diagfi.nc" every ecritphy dynamical steps 
-      INTEGER ecritstart ! output data in "start.nc" every ecritstart dynamical steps 
-      REAL timestart ! time start for run in "start.nc"
-      real nday_r ! number of days to run (possibly including a fraction of day)
-
-!-----------------------------------------------------------------------
Index: trunk/LMDZ.MARS/libf/dyn3d/control_mod.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/control_mod.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/dyn3d/control_mod.F90	(revision 1130)
@@ -0,0 +1,19 @@
+
+module control_mod
+
+  implicit none
+
+  integer,save :: ndynstep ! # of dynamical time steps to run (if negative or not specified in run.def, nday_r is used instead)
+  integer,save :: day_step ! # of dynamical time steps per day
+  integer,save :: iperiod  ! make a Matsuno step before avery iperiod-1 LF steps
+  integer,save :: iconser !
+  integer,save :: idissip ! apply dissipation every idissip dynamical step
+  integer,save :: iphysiq ! call physics every iphysiq dynamical steps
+  integer,save :: anneeref ! reference year # ! not used
+  real,save :: periodav
+  real,save :: ecritphy ! output data in "diagfi.nc" every ecritphy dynamical steps 
+  integer,save :: ecritstart ! output data in "start.nc" every ecritstart dynamical steps 
+  real,save :: timestart ! time start for run in "start.nc"
+  real,save :: nday_r ! number of days to run (possibly including a fraction of day)
+
+end module control_mod
Index: trunk/LMDZ.MARS/libf/dyn3d/defrun_new.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/defrun_new.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/defrun_new.F	(revision 1130)
@@ -36,10 +36,13 @@
 c   --------------
 ! to use  'getin'
-      USE ioipsl_getincom
+      use ioipsl_getincom, only: getin
+      use control_mod, only: ndynstep, day_step, iperiod, iconser,
+     &                       idissip, iphysiq, anneeref, ecritphy,
+     &                       ecritstart, timestart, nday_r
       IMPLICIT NONE
 
 #include "dimensions.h"
 #include "paramet.h"
-#include "control.h"
+!#include "control.h"
 #include "logic.h"
 #include "serre.h"
@@ -83,6 +86,5 @@
 !le modele martien et ne sont donc plus lues dans "run.def"
 
-        anneeref=0
-        ! Note: anneref is a common in 'control.h'
+      anneeref=0
 
       OPEN(tapedef,file='run.def',status='old',form='formatted'
Index: trunk/LMDZ.MARS/libf/dyn3d/dynetat0.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/dynetat0.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/dynetat0.F	(revision 1130)
@@ -3,5 +3,6 @@
       
       use netcdf
-      use infotrac, only: tnom
+      use infotrac, only: tname
+      use control_mod, only: timestart
       
       IMPLICIT NONE
@@ -39,5 +40,5 @@
 #include "logic.h"
 !#include "advtrac.h"
-#include "control.h"
+!#include "control.h"
 
 c   Arguments:
@@ -381,10 +382,10 @@
 !           WRITE(str3(2:3),'(i2.2)') iq
 !           ierr =  NF_INQ_VARID (nid, str3, nvarid)
-! NB: tracers are now read in using their name ('tnom' from infotrac)
-!           write(*,*) "  loading tracer:",trim(tnom(iq))
-           ierr=nf90_inq_varid(nid,tnom(iq),nvarid)
+! NB: tracers are now read in using their name ('tname' from infotrac)
+!           write(*,*) "  loading tracer:",trim(tname(iq))
+           ierr=nf90_inq_varid(nid,tname(iq),nvarid)
            IF (ierr .NE. nf90_noerr) THEN
 !              PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
-              PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
+              PRINT*, "dynetat0: Le champ <"//trim(tname(iq))//
      &                "> est absent"
               PRINT*, "          Il est donc initialise a zero"
@@ -396,5 +397,5 @@
              IF (ierr .NE. nf90_noerr) THEN
 !                 PRINT*, "dynetat0: Lecture echouee pour "//str3
-               PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
+               PRINT*,"dynetat0: Lecture echouee pour "//trim(tname(iq))
                CALL abort
              ENDIF
Index: trunk/LMDZ.MARS/libf/dyn3d/dynredem.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/dynredem.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/dynredem.F	(revision 1130)
@@ -1,4 +1,4 @@
       SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
-      use infotrac, only: tnom
+      use infotrac, only: tname
       IMPLICIT NONE
 c=======================================================================
@@ -912,9 +912,9 @@
 !               ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
 !     .                          "Traceurs "//str3)
-             txt="Traceur "//trim(tnom(iq))
-#ifdef NC_DOUBLE
-               ierr=NF_DEF_VAR(nid,tnom(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-               ierr=NF_DEF_VAR(nid,tnom(iq),NF_FLOAT,4,dims4,nvarid)
+             txt="Traceur "//trim(tname(iq))
+#ifdef NC_DOUBLE
+               ierr=NF_DEF_VAR(nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
+#else
+               ierr=NF_DEF_VAR(nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
 #endif
                ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",
@@ -964,5 +964,5 @@
       SUBROUTINE dynredem1(fichnom,time,
      .                     vcov,ucov,teta,q,nq,masse,ps)
-      use infotrac, only: nqtot, tnom
+      use infotrac, only: nqtot, tname
       IMPLICIT NONE
 c=================================================================
@@ -1105,8 +1105,8 @@
 !            WRITE(str3(2:3),'(i2.2)') iq
 !            ierr = NF_INQ_VARID(nid, str3, nvarid)
-            ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
+            ierr=NF_INQ_VARID(nid,tname(iq),nvarid)
             IF (ierr .NE. NF_NOERR) THEN
 !               PRINT*, "Variable "//str3//" n est pas definie"
-              PRINT*, "Variable "//trim(tnom(iq))//" n est pas definie"
+              PRINT*, "Variable "//trim(tname(iq))//" n est pas definie"
               CALL abort
             ENDIF
Index: trunk/LMDZ.MARS/libf/dyn3d/gcm.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1130)
@@ -2,4 +2,8 @@
 
       use infotrac, only: iniadvtrac, nqtot, iadv
+      use control_mod, only: day_step, iperiod, iphysiq, ndynstep,
+     &                       nday_r, idissip, iconser, ecritstart,
+     &                       ecritphy
+      use comgeomphy, only: initcomgeomphy
       IMPLICIT NONE
 
@@ -42,5 +46,5 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
+!#include "control.h"
 #include "ener.h"
 #include "netcdf.inc"
@@ -135,4 +139,16 @@
       logical callgroupeun
       parameter (callgroupeun = .false.)
+
+c-----------------------------------------------------------------------
+c    variables pour l'initialisation de la physique :
+c    ------------------------------------------------
+      INTEGER ngridmx
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+      REAL zcufi(ngridmx),zcvfi(ngridmx)
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+      INTEGER i,j
+
 c-----------------------------------------------------------------------
 c   Initialisations:
@@ -145,4 +161,14 @@
 c-----------------------------------------------------------------------
       CALL defrun_new( 99, .TRUE. )
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH 2008/05/02
+! A nettoyer. On ne veut qu'une ou deux routines d'interface 
+! dynamique -> physique pour l'initialisation
+!#ifdef CPP_PHYS
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+!#endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 ! Initialize tracers
@@ -196,4 +222,46 @@
 c
 
+c-----------------------------------------------------------------------
+c   Initialisation de la physique :
+c   -------------------------------
+
+!      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
+         latfi(1)=rlatu(1)
+         lonfi(1)=0.
+         zcufi(1) = cu(1)
+         zcvfi(1) = cv(1)
+         DO j=2,jjm
+            DO i=1,iim
+               latfi((j-2)*iim+1+i)= rlatu(j)
+               lonfi((j-2)*iim+1+i)= rlonv(i)
+               zcufi((j-2)*iim+1+i) = cu((j-1)*iip1+i)
+               zcvfi((j-2)*iim+1+i) = cv((j-1)*iip1+i)
+            ENDDO
+         ENDDO
+         latfi(ngridmx)= rlatu(jjp1)
+         lonfi(ngridmx)= 0.
+         zcufi(ngridmx) = cu(ip1jm+1)
+         zcvfi(ngridmx) = cv(ip1jm-iim)
+
+         ! build airefi(), mesh area on physics grid
+         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+         ! Poles are single points on physics grid
+         airefi(1)=airefi(1)*iim
+         airefi(ngridmx)=airefi(ngridmx)*iim
+
+! Initialisation de la physique: pose probleme quand on tourne 
+! SANS physique, car iniphysiq.F est dans le repertoire phy[]... 
+! Il faut une cle CPP_PHYS
+!#ifdef CPP_PHYS
+!         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
+         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys,
+     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
+     &                1)
+!     &                iflag_phys)
+!#endif
+!         call_iniphys=.false.
+!      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
+!        call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
+!     .                latfi,lonfi,airefi,rad,g,r,cpp)
 
       call dump2d(iip1,jjp1,ps,'PRESSION SURFACE')
Index: trunk/LMDZ.MARS/libf/dyn3d/infotrac.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/infotrac.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/infotrac.F90	(revision 1130)
@@ -5,5 +5,5 @@
   INTEGER, SAVE :: nqtot
   INTEGER,allocatable :: iadv(:)   ! tracer advection scheme number
-  CHARACTER(len=20),allocatable ::  tnom(:) ! tracer name
+  CHARACTER(len=20),allocatable ::  tname(:) ! tracer name
 
 CONTAINS
@@ -18,7 +18,7 @@
       IMPLICIT NONE
 
-#include "dimensions.h"
+!#include "dimensions.h"
 !#include "advtrac.h"
-#include "control.h"
+!#include "control.h"
 
 ! routine arguments:
@@ -47,5 +47,5 @@
         ! allocate arrays:
         allocate(iadv(nq))
-        allocate(tnom(nq))
+        allocate(tname(nq))
         
         ! initialize advection schemes to Van-Leer for all tracers
@@ -56,5 +56,5 @@
         do iq=1,nq
         ! minimal version, just read in the tracer names, 1 per line
-          read(90,*,iostat=ierr) tnom(iq)
+          read(90,*,iostat=ierr) tname(iq)
           if (ierr.ne.0) then
             write(*,*) 'iniadvtrac: error reading tracer names...'
Index: trunk/LMDZ.MARS/libf/dyn3d/ini_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/ini_archive.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/ini_archive.F	(revision 1130)
@@ -48,5 +48,5 @@
 #include "description.h"
 #include "serre.h"
-#include "control.h"
+!#include "control.h"
 !#include"comsoil.h"
 
Index: trunk/LMDZ.MARS/libf/dyn3d/iniconst.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/iniconst.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/iniconst.F	(revision 1130)
@@ -1,4 +1,5 @@
       SUBROUTINE iniconst
 
+      use control_mod, only: iphysiq, idissip
       IMPLICIT NONE
 c
@@ -13,5 +14,5 @@
 #include "comconst.h"
 #include "temps.h"
-#include "control.h"
+!#include "control.h"
 #include "comvert.h"
 
Index: trunk/LMDZ.MARS/libf/dyn3d/inidissip.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/inidissip.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/inidissip.F	(revision 1130)
@@ -8,4 +8,5 @@
 c   -------------
 
+      use control_mod, only: idissip, iperiod
       IMPLICIT NONE
 #include "dimensions.h"
@@ -14,5 +15,5 @@
 #include "comconst.h"
 #include "comvert.h"
-#include "control.h"
+!#include "control.h"
 
       LOGICAL lstardis
Index: trunk/LMDZ.MARS/libf/dyn3d/lect_start_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/lect_start_archive.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/lect_start_archive.F	(revision 1130)
@@ -17,5 +17,5 @@
 c
 c=======================================================================
-      use infotrac, only: tnom
+      use infotrac, only: tname
       use comsoil_h, only: nsoilmx, layer, mlayer, volcapa, inertiedat
       implicit none
@@ -32,10 +32,10 @@
 #include "comvert.h"
 #include "comgeom2.h"
-#include "control.h"
+!#include "control.h"
 #include "logic.h"
 #include "description.h"
 #include "ener.h"
 #include "temps.h"
-#include "lmdstd.h"
+!#include "lmdstd.h"
 #include "netcdf.inc"
 !#include "tracer.h"
@@ -760,5 +760,5 @@
           write(txt,'(a5,i2.2)')'qsurf',iq
         ELSE
-          txt=trim(tnom(iq))//"_surf"
+          txt=trim(tname(iq))//"_surf"
           if (txt.eq."h2o_vap") then
             ! There is no surface tracer for h2o_vap;
@@ -948,5 +948,5 @@
           write(txt,'(a1,i2.2)')'q',iq
         ELSE
-          txt=tnom(iq)
+          txt=tname(iq)
         ENDIF
         write(*,*)"lect_start_archive: loading tracer ",trim(txt)
Index: trunk/LMDZ.MARS/libf/dyn3d/mod_const_mpi.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/mod_const_mpi.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/dyn3d/mod_const_mpi.F90	(revision 1130)
@@ -0,0 +1,16 @@
+MODULE mod_const_mpi
+
+  INTEGER :: COMM_LMDZ
+  INTEGER :: MPI_REAL_LMDZ
+ 
+
+CONTAINS 
+
+  SUBROUTINE init_const_mpi
+  IMPLICIT NONE
+  
+    COMM_LMDZ=0
+    MPI_REAL_LMDZ=0
+  END SUBROUTINE init_const_mpi
+
+END MODULE mod_const_mpi
Index: trunk/LMDZ.MARS/libf/dyn3d/newstart.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/newstart.F	(revision 1127)
+++ 	(revision )
@@ -1,1641 +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=======================================================================
-
-! to use  'getin'
-      use ioipsl_getincom, only: getin 
-      use infotrac, only: iniadvtrac, nqtot, tnom
-      use tracer_mod, only: noms, igcm_dust_number, igcm_dust_mass,
-     &                      igcm_ccn_number, igcm_ccn_mass,
-     &                      igcm_h2o_vap, igcm_h2o_ice
-      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
-     &                     albedodat, z0_default
-      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "dimphys.h"
-!#include "surfdat.h"
-!#include "comsoil.h"
-!#include "dimradmars.h"
-!#include "yomaer.h"
-#include "planete.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "control.h"
-#include "logic.h"
-#include "description.h"
-#include "ener.h"
-#include "temps.h"
-#include "lmdstd.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-#include "serre.h"
-#include "netcdf.inc"
-!#include"advtrac.h"
-!#include"tracer.h"
-#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 size
-      INTEGER length
-      parameter (length = 100)
-      INTEGER tab0
-      INTEGER   NB_ETATMAX
-      parameter (NB_ETATMAX = 100)
-
-      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 tsurf(ngridmx)	! surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
-      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL emis(ngridmx)	! surface emissivity
-      REAL,ALLOCATABLE :: qsurf(:,:)
-      REAL q2(ngridmx,nlayermx+1)
-!      REAL rnaturfi(ngridmx)
-      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
-      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
-      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
-      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
-
-      INTEGER i,j,l,isoil,ig,idum
-      real mugaz ! molar mass of the atmosphere
-
-      EXTERNAL iniconst,geopot,inigeom
-      integer ierr  !, nbetat
-      integer ismin
-      external ismin
-
-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
-      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 :: nq,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
-
-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)
-
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-! allocate arrays
-      allocate(q(iip1,jjp1,llm,nqtot))
-      allocate(qsurf(ngridmx,nqtot))
-      
-c=======================================================================
-c   Choice of the start file(s) to use
-c=======================================================================
-
-      write(*,*) 'From which kind of files do you want to create new',
-     .  'start and startfi files'
-      write(*,*) '    0 - from a file start_archive'
-      write(*,*) '    1 - from files start and startfi'
- 
-c-----------------------------------------------------------------------
-c   Open file(s) to modify (start or start_archive)
-c-----------------------------------------------------------------------
-
-      DO
-         read(*,*,iostat=ierr) choix_1
-         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
-      ENDDO
-
-c     Open start_archive
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start_archive.nc'
-        write(*,*)
-        fichnom = 'start_archive.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-        tab0 = 50 
-        Lmodif = 1
-
-c     OR open start and startfi files
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      else
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start.nc and ./startfi.nc'
-        write(*,*)
-        fichnom = 'start.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
- 
-        fichnom = 'startfi.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-
-        tab0 = 0 
-        Lmodif = 0
-
-      endif
-
-c-----------------------------------------------------------------------
-c 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
-         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
-         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)=airefi(1)*iim
-      airefi(ngridmx)=airefi(ngridmx)*iim
-
-! also initialize various physics flags/settings which might be needed
-!    (for instance initracer needs to know about some flags, and/or
-!      'datafile' path may be changed by user)
-      call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
-     &                latfi,lonfi,airefi,rad,g,r,cpp)
-
-c=======================================================================
-c   lecture topographie, albedo, inertie thermique, relief sous-maille
-c=======================================================================
-
-      if (choix_1.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,
-     &   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)
-        
-        ! 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.tnom(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,co2ice)
-      
-      if (count.eq.nqtot) then
-        write(*,*) 'Newstart: updating tracer names'
-        ! copy noms(:) to tnom(:) to have matching tracer names in physics
-        ! and dynamics
-        tnom(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(*,*) '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(tnom(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(tnom(iq)),' to ?'
-            read(*,*) txt
-            tnom(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(tnom(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(tnom(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(tnom(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(tnom(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(tnom(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(tnom(iq)),' initialized ',
-     &                     'using values from file ',trim(txt)
-               else
-                 write(*,*)'problem reading file ',trim(txt),' !'
-                 write(*,*)'No modifications to tracer ',trim(tnom(iq))
-               endif
-             else
-               write(*,*)'Could not find file ',trim(txt),' !'
-               write(*,*)'No modifications to tracer ',trim(tnom(iq))
-             endif
-             
-c       q=profile : initialize tracer with a given profile
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'freedust') then
-          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) * 1e-3 ! grosso modo
-                if (igcm_dust_mass .ne. 0) 
-     &          q(i,j,l,igcm_dust_mass)=
-     &                q(i,j,l,igcm_dust_mass)   * 1e-3 ! grosso modo
-                if (igcm_ccn_number .ne. 0) 
-     &          q(i,j,l,igcm_ccn_number)=
-     &                q(i,j,l,igcm_ccn_number) * 1e-3 ! grosso modo
-                if (igcm_ccn_mass .ne. 0) 
-     &          q(i,j,l,igcm_ccn_mass)=
-     &                q(i,j,l,igcm_ccn_mass)   * 1e-3 ! grosso modo
-              end do
-            end do
-          end do
-
-         ! 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
-
-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, nq, 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(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      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)
-
-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/~forget/datagcm/datafile'
-        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/dyn3d/start2archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/start2archive.F	(revision 1127)
+++ 	(revision )
@@ -1,406 +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, tnom
-      use comsoil_h, only: nsoilmx, inertiedat
-      use surfdat_h, only: ini_surfdat_h
-      use comsoil_h, only: ini_comsoil_h
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "temps.h"
-#include "control.h"
-#include "ener.h"
-#include "description.h"
-
-!#include "dimphys.h"
-!#include "comsoil.h"
-!#include"advtrac.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c   Declarations
-c-----------------------------------------------------------------------
-
-c variables dynamiques du GCM
-c -----------------------------
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
-      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
-      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
-      REAL pk(ip1jmp1,llm)
-      REAL pkf(ip1jmp1,llm)
-      REAL beta(iip1,jjp1,llm)
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
-      REAL ps(ip1jmp1)                       ! pression au sol
-      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
-      
-c Variable Physiques (grille physique)
-c ------------------------------------
-      REAL tsurf(ngridmx)	! Surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
-      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL q2(ngridmx,llm+1)
-      REAL,ALLOCATABLE :: qsurf(:,:)
-      REAL emis(ngridmx)
-      INTEGER start,length
-      PARAMETER (length = 100)
-      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
-      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 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.
-
-c=======================================================================
-c Lecture des donnees
-c=======================================================================
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-
-! allocate arrays:
-      allocate(q(ip1jmp1,llm,nqtot))
-      allocate(qsurf(ngridmx,nqtot))
-      allocate(qsurfS(ip1jmp1,nqtot))
-      call ini_surfdat_h(ngridmx)
-      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)
-
-       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
-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)
-
-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,'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,tnom(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(tnom(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-----------------------------------------------------------------------
-
-      end 
Index: trunk/LMDZ.MARS/libf/dyn3d/write_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/write_archive.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/write_archive.F	(revision 1130)
@@ -38,5 +38,5 @@
 #include "dimphys.h"
 #include "paramet.h"
-#include "control.h"
+!#include "control.h"
 #include "comvert.h"
 #include "comgeom.h"
Index: trunk/LMDZ.MARS/libf/dyn3d/writediagdyn.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/writediagdyn.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/dyn3d/writediagdyn.F90	(revision 1130)
@@ -12,9 +12,10 @@
 ! NB: the rate a which outputs are made can be changed (see parameter isample)
 !
+use control_mod, only: iphysiq, day_step
 implicit none
 
 #include"dimensions.h"
 #include"paramet.h"
-#include"control.h"
+!#include"control.h"
 #include"netcdf.inc"
 
Index: trunk/LMDZ.MARS/libf/dyn3d/xvik.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/xvik.F	(revision 1127)
+++ 	(revision )
@@ -1,546 +1,0 @@
-      PROGRAM xvik
-      IMPLICIT NONE
-c=======================================================================
-c
-c  Pression au site Viking
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-#include "control.h"
-#include "ener.h"
-#include "description.h"
-#include "netcdf.inc"      
-
-
-      INTEGER itau,nbpas,nbpasmx
-      PARAMETER(nbpasmx=1000000)
-      REAL temps(nbpasmx)
-      INTEGER unitlec
-      INTEGER i,j,l,jj
-      REAL constR
-
-c   Declarations NCDF:
-c   -----------------
-      CHARACTER*100  varname
-      INTEGER ierr,nid,nvarid,dimid
-      LOGICAL nc
-      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
-      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
-
-c   declarations pour les points viking:
-c   ------------------------------------
-      INTEGER ivik(2),jvik(2),ifile(2),iv
-      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
-      REAL unanj
-
-c   variables meteo:
-c   ----------------
-      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
-      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
-      REAL co2ice(iip1,jjp1), captotN,captotS
-      real t7(iip1,jjp1) ! temperature in 7th atmospheric layer
-
-      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
-
-      LOGICAL firstcal,lcal,latcal,lvent,day_ls
-      INTEGER*4 day0
-
-      REAL ziceco2(iip1,jjp1)
-      REAL day,zt,sollong,sol,dayw
-      REAL airtot1,gh
-
-      INTEGER ii,iyear,kyear
-
-      CHARACTER*2 chr2
-
-       
-c   declarations de l'interface avec mywrite:
-c   -----------------------------------------
-
-      CHARACTER file*80
-      CHARACTER pathchmp*80,pathsor*80,nomfich*80
-
-c   externe:
-c   --------
-
-      EXTERNAL iniconst,inigeom,covcont,mywrite
-      EXTERNAL inifilr,exner,pbar
-      EXTERNAL solarlong,coordij,moy2
-      EXTERNAL SSUM
-      REAL SSUM
-      EXTERNAL lnblnk
-      INTEGER lnblnk
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      unanj=667.9
-      print*,'WARNING!!!',unanj,'Jours/an'
-      nc=.true.
-      lcal=.true.
-      latcal=.true.
-      lvent=.false.
-      day_ls=.true.
-
-c lecture du fichier xvik.def
-
-      phivik(1)=-3627
-      phivik(2)=-4505
-
-
-
-      OPEN(99,file='xvik.def',form='formatted')
-
-      READ(99,*) 
-      READ(99,*,iostat=ierr) phivik
-      IF(ierr.NE.0) GOTO 105
-
-      READ(99,*,END=105)
-      READ(99,'(a)',END=105) pathchmp
-      READ(99,*,END=105)
-      READ(99,'(a)',END=105) pathsor
-      READ(99,*,END=105)
-c     READ(99,'(l1)',END=105) day_ls
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) lcal
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) lvent
-      READ(99,'(l1)',END=105)
-      READ(99,'(l1)',END=105) latcal
- 
- 105  CONTINUE
-      CLOSE(99)
-      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
-      DO iv=1,2
-         phivik(iv)=phivik(iv)*3.73
-      END DO
-
-      write(*,*) ' pathchmp:',trim(pathchmp)
-      write(*,*) ' pathsor:',trim(pathsor)
-      
-c-----------------------------------------------------------------------
-c-----------------------------------------------------------------------
-c   ouverture des fichiers xgraph:
-c   ------------------------------
-
-      ifile(1)=12
-      ifile(2)=13
-      kyear=-1
-c      OPEN(77,file='xlongday',form='formatted')
-
-      unitlec=11
-c
-      PRINT*,'entrer le nom du fichier NC'
-      READ(5,'(a)') nomfich
-
-      PRINT *,'nomfich : ',nomfich
-
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-c   grande boucle sur les fichiers histoire:
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      firstcal=.true.
-      DO WHILE(lnblnk(nomfich).GT.0.AND.lnblnk(nomfich).LT.50)
-      PRINT *,'>>>  nomfich : ',trim(nomfich)
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      file=pathchmp(1:lnblnk(pathchmp))//'/'//
-     s     nomfich(1:lnblnk(nomfich))
-      PRINT*,'file.nc: ', file(1:lnblnk(file))//'.nc'
-      PRINT*,'timestep ',dtvr
-
-      IF(nc) THEN
-      ierr= NF_OPEN(file(1:lnblnk(file))//'.nc',NF_NOWRITE,nid)        
-      ELSE
-         PRINT*,'Ouverture binaire ',file
-         OPEN(unitlec,file=file,status='old',form='unformatted',
-     .   iostat=ierr)
-      ENDIF
-
-c----------------------------------------------------------------------
-c   initialisation de la physique:
-c   ------------------------------
-
-      CALL readhead_NC(file(1:lnblnk(file))//'.nc',day0,phis,constR)
-
-      WRITE (*,*) 'day0 = ' , day0
-
-      CALL iniconst
-      CALL inigeom
-      CALL inifilr
-
-
-c   Lecture temps :
-
-      ierr= NF_INQ_DIMID (nid,"Time",dimid)
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'xvik: Le champ <Time> est absent'
-          CALL abort
-        ENDIF
-
-      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
-
-      ierr = NF_INQ_VARID (nid, "Time", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
-#endif
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'xvik: Lecture echouee pour <Time>'
-          CALL abort
-        ENDIF
-
-        PRINT*,'temps',(temps(itau),itau=1,10)
-              
-c-----------------------------------------------------------------------
-c   coordonnees des point Viking:
-c   -----------------------------
-
-      latvik(1)=22.27*pi/180.
-      lonvik(1)=-47.9*pi/180.
-      latvik(2)=47.67*pi/180.
-      lonvik(2)=(360.-225.71)*pi/180.
-
-c   ponderations pour les 4 points autour de Viking
-      DO iv=1,2
-         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
-         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
-            ivik(iv)=ivik(iv)-1
-         ENDIF
-         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
-            jvik(iv)=jvik(iv)-1
-         ENDIF
-         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
-     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
-         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
-     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
-         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
-         zw(1,0,iv)=zalpha*(1.-zbeta)
-         zw(0,1,iv)=(1.-zalpha)*zbeta
-         zw(1,1,iv)=zalpha*zbeta
-      ENDDO
-
-c   altitude reelle et modele aux points Viking
-      DO iv=1,2
-         phisim(iv)=0.
-         DO jj=0,1
-            j=jvik(iv)+jj
-            DO ii=0,1
-               i=ivik(iv)+ii
-               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
-            ENDDO
-         ENDDO
-      ENDDO
-      PRINT*,'relief aux points Viking pour les sorties:',phivik
-
-c----------------------------------------------------------------------
-c   lectures des etats:
-c   -------------------
-
-       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
-
-c======================================================================
-c   debut de la boucle sur les etats dans un fichier histoire:
-c======================================================================
-       count_ps=(/iip1,jjp1,1/)
-       count_co2ice=(/iip1,jjp1,1/)
-       count_temp=(/iip1,jjp1,llm,1/)
-       
-       DO itau=1,nbpas
-
-       start_ps=(/1,1,itau/)
-       start_co2ice=(/1,1,itau/)
-       start_temp=(/1,1,1,itau/)
-c   lecture drs des champs:
-c   -----------------------
-c         varname='u'
-c         ierr=drsread (unitlec,varname,unat,itau)
-c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
-c         varname='v'
-c         ierr=drsread (unitlec,varname,vnat,itau)
-c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
-
-ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "ps", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <ps>'
-            CALL abort
-          ENDIF
-          
-          PRINT*,'ps',ps(iip1/2,jjp1/2)
-
-ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "temp", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
-#else
-          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <temp>'
-            ! Ehouarn: proceed anyways
-            ! CALL abort
-            write(*,*)'--> Setting temperature to zero !!!'
-            t(1:iip1,1:jjp1,1:llm)=0.0
-            write(*,*)'--> looking for temp7 (temp in 7th layer)'
-            ierr=NF_INQ_VARID(nid,"temp7", nvarid)
-            if (ierr.eq.NF_NOERR) then
-            write(*,*) "    OK, found temp7 variable"
-#ifdef NC_DOUBLE
-            ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start_ps,count_ps,t7)
-#else
-            ierr=NF_GET_VARA_REAL(nid,nvarid,start_ps,count_ps,t7)
-#endif
-              if (ierr.ne.NF_NOERR) then
-                write(*,*)'xvik: failed loading temp7 !'
-                stop
-              endif
-            else ! no 'temp7' variable
-              write(*,*)'  No temp7 variable either !'
-              write(*,*)'  Will have to to without ...'
-              t7(1:iip1,1:jjp1)=0.0
-            endif
-          ELSE ! t() was successfully loaded, copy 7th layer to t7()
-            t7(1:iip1,1:jjp1)=t(1:iip1,1:jjp1,7)
-          ENDIF
-
-c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
-
-ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
-          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
-     &    count_co2ice,  co2ice)
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
-     &    count_co2ice, co2ice)
-#endif
-          IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
-            CALL abort
-          ENDIF
-
-
-c Gestion du temps
-c ----------------
-          day=temps(itau)
-          PRINT*,'day ',day
-          CALL solarlong(day+day0,sollong)
-          sol=day+day0+461.
-          iyear=sol/unanj
-          WRITE (*,*) 'iyear',iyear
-          sol=sol-iyear*unanj
-c
-c Ouverture / fermeture des fichiers
-c ----------------------------------
-          IF (iyear.NE.kyear) THEN
-             WRITE(chr2(1:1),'(i1)') iyear+1
-             WRITE (*,*) 'iyear bis',iyear
-             WRITE (*,*) 'chr2'
-             WRITE (*,*)  chr2
-             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
-             kyear=iyear
-             DO ii=1,2
-                CLOSE(10+ifile(ii))
-                CLOSE(2+ifile(ii))
-                CLOSE(4+ifile(ii))
-                CLOSE(6+ifile(ii))
-                CLOSE(8+ifile(ii))
-                CLOSE(16+ifile(ii))
-                CLOSE(12+ifile(ii))
-                CLOSE(14+ifile(ii))
-                CLOSE(97)
-                CLOSE(98)
-             ENDDO
-             CLOSE(5+ifile(1))
-             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
-             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
-c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
-c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
-c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
-c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
-             IF(lcal) THEN
-c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
-c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
-c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
-             ENDIF
-                         IF(latcal) THEN
-c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
-c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
-                         ENDIF
-             IF(lvent) THEN
-c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
-c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
-c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
-c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
-             ENDIF
-             OPEN(97,file='xprestot'//chr2,form='formatted')
-c            OPEN(98,file='xlat37_'//chr2,form='formatted')
-           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
-          ENDIF
- 
-
-          sollong=sollong*180./pi
-          IF(day_ls) THEN
-             dayw=sol
-             write(*,*) 'dayw', dayw
-          ELSE
-             dayw=sollong
-          ENDIF
-
-c Calcul de la moyenne planetaire
-c -------------------------------
-          pstot=0.
-          captotS=0.
-          captotN=0.
-          DO j=1,jjp1
-             DO i=1,iim
-                pstot=pstot+aire(i,j)*ps(i,j)
-             ENDDO
-          ENDDO
- 
-              DO j=1,jjp1/2
-                 DO i=1,iim
-                    captotN = captotN  +aire(i,j)*co2ice(i,j)
-                 ENDDO
-              ENDDO
-              DO j=jjp1/2+1, jjp1
-                 DO i=1,iim
-                    captotS = captotS  +aire(i,j)*co2ice(i,j)
-                 ENDDO
-              ENDDO
-              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
-     &       , captotN*g*airtot1, captotS*g*airtot1          
-
-          IF(.NOT.firstcal) THEN
-         WRITE(98,'(f5.1,16f7.3)')
-     s    dayw,(ps(i,37),i=1,iim,4)
-
-c boucle sur les sites vikings:
-c ----------------------------
-
-          DO iv=1,2
-
-c interpolation de la temperature dans la 7eme couche, de la pression
-c de surface et des vents aux points viking.
-
-             zp1=0.
-             zp2=0.
-             zp2_sm=0.
-             zt=0.
-             zu=0.
-             zv=0.
-             DO jj=0,1
-                j=jvik(iv)+jj
-                DO ii=0,1
-                   i=ivik(iv)+ii
-!                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
-                   zt=zt+zw(ii,jj,iv)*t7(i,j)
-!                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
-                   zp1=zp1+zw(ii,jj,iv)*log(ps(i,j)) ! interpolate in log(P)
-                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
-                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
-                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
-                ENDDO
-             ENDDO
-             zp1=exp(zp1) ! because of the bilinear interpolation in log(P)
- 
-c               pression au sol extrapolee a partir de la temp. 7eme couche
-           WRITE (*,*) 'constR ',constR 
-           WRITE (*,*) 'zt ',zt
-             gh=constR*zt
-             if (gh.eq.0) then ! if we don't have temperature values
-               ! assume a scale height of 10km
-               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/(3.73*1.e4))
-             else
-               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
-             endif
-           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
-           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
-!           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
-           WRITE(ifile(iv)+10,'(3e15.5)') dayw,zp2,zp1
-           
-c   sorties eventuelles de vent
-             IF(lvent) THEN
-                WRITE(ifile(iv)+16,'(2e15.5)')
-     s          dayw,zu
-                WRITE(ifile(iv)+12,'(2e15.5)')
-     s          dayw,zv
-             ENDIF
-          ENDDO
-c         IF (lcal) THEN
-c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
-c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
-c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
-c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
-c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
-c         ENDIF
-c            IF(latcal) THEN
-c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
-c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
-c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
-c            ENDIF
-         ENDIF
-         firstcal=.false.
-
-c======================================================================
-c   Fin de la boucle sur les etats du fichier histoire:
-c======================================================================
-      ENDDO
-
-      ierr= NF_CLOSE(nid)
-
-      PRINT*,'Fin du fichier',nomfich
-      print*,'Entrer un nouveau fichier ou return pour finir'
-      READ(5,'(a)',err=9999) nomfich
-
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-c   Fin de la boucle sur les fichiers histoire:
-c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-      ENDDO
-
-      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
-      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
-      DO iv=1,2
-         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
-         WRITE(6,7777)
-     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
-         print*
-         DO j=jvik(iv)-1,jvik(iv)+2
-            WRITE(6,'(f8.1,10x,5f7.1)')
-     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
-         ENDDO
-         print*
-         print*,'zw'
-         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
-         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
-      ENDDO
-      PRINT*,'R=',r
- 9999  PRINT*,'Fin '
-
-7777  FORMAT ('latitude/longitude',4f7.1)
-      END
Index: trunk/LMDZ.MARS/libf/phymars/albedocaps.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/albedocaps.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/albedocaps.F90	(revision 1130)
@@ -6,7 +6,5 @@
 ! to use the 'getin' routine 
 use ioipsl_getincom, only: getin
-#ifdef MESOSCALE
-use comgeomfi_h
-#endif
+use comgeomfi_h, only: lati ! grid point latitudes (rad)
 use surfdat_h, only: TESicealbedo, TESice_Ncoef, TESice_Scoef, &
                      emisice, albedice, watercaptag, albedo_h2o_ice, &
@@ -59,9 +57,5 @@
 
 do ig=1,ngrid
-#ifndef MESOSCALE
-  if (ig.gt.ngrid/2+1) then
-#else
-  if (lati(ig)*180./acos(-1.).lt.0.) then
-#endif
+  if (lati(ig).lt.0.) then
     icap=2 ! Southern hemisphere
   else
@@ -74,8 +68,5 @@
     ! set the surface albedo to be the ice albedo
     if (TESicealbedo) then
-!      write(*,*) "albedocaps: call TES_icecap_albedo"
-!      write(*,*) "albedocaps: zls=",zls," ig=",ig
       call TES_icecap_albedo(zls,ig,psolaralb(ig,1),icap)
-!      write(*,*) "albedocaps: psolaralb(ig,1)=",psolaralb(ig,1)
       psolaralb(ig,2)=psolaralb(ig,1)
     else
@@ -86,5 +77,4 @@
     ! there is a water ice cap: set the surface albedo to the water ice one
     ! to do : emissivity
-    !write(*,*) "watercaptag in albedocaps:",ig
     emisref(ig) = 1
     psolaralb(ig,1)=albedo_h2o_ice
@@ -105,4 +95,7 @@
 use comgeomfi_h, only: lati, long
 use surfdat_h, only: albedice, TESice_Ncoef, TESice_Scoef
+use netcdf, only: nf90_open, NF90_NOWRITE, NF90_NOERR, &
+                  nf90_strerror, nf90_inq_varid, nf90_get_var, nf90_close
+                  
 implicit none
 #include"dimensions.h"
@@ -110,5 +103,4 @@
 !#include"surfdat.h"
 !#include"comgeomfi.h"
-#include"netcdf.inc"
 #include"datafile.h"
 
@@ -169,6 +161,6 @@
 ! Load TES albedoes for Northern Hemisphere
   ! Note: datafile() is defined in "datafile.h"
-  ierr=NF_OPEN(trim(datafile)//"/npsc_albedo.nc",NF_NOWRITE,nid)
-  IF (ierr.NE.NF_NOERR) THEN
+  ierr=nf90_open(trim(datafile)//"/npsc_albedo.nc",NF90_NOWRITE,nid)
+  IF (ierr.NE.NF90_NOERR) THEN
     write(*,*)'Problem opening npsc_albedo.nc (phymars/albedocaps.F90)'
     write(*,*)'It should be in :',trim(datafile),'/'
@@ -179,37 +171,69 @@
     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
     CALL ABORT
+  ELSE
+    write(*,*) "albedocaps: using file ",trim(datafile)//"/npsc_albedo.nc"
   ENDIF
   
-  ierr=NF_INQ_VARID(nid,"longitude",nvarid)
-  if (ierr.ne.NF_NOERR) then
+  ierr=nf90_inq_varid(nid,"longitude",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find longitude in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlon)
-  endif
-  
-  ierr=NF_INQ_VARID(nid,"latitude",nvarid)
-  if (ierr.ne.NF_NOERR) then
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESlon)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading longitude data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+  
+  ierr=nf90_inq_varid(nid,"latitude",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find latitude in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlatn)
-  endif
-  
-  ierr=NF_INQ_VARID(nid,"time",nvarid)
-  if (ierr.ne.NF_NOERR) then
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESlatn)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading latitude data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+  
+  ierr=nf90_inq_varid(nid,"time",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find time in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESls)
-  endif
-  
-  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
-  if (ierr.ne.NF_NOERR) then
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESls)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading time data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+  
+  ierr=nf90_inq_varid(nid,"albedo",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find albedo in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbn)
-  endif
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESalbn)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading albedo data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+
+  ierr=nf90_close(nid)
 
 ! Load albedoes for Southern Hemisphere
-  ierr=NF_OPEN(trim(datafile)//"/spsc_albedo.nc",NF_NOWRITE,nid)
-  IF (ierr.NE.NF_NOERR) THEN
+  ierr=nf90_open(trim(datafile)//"/spsc_albedo.nc",NF90_NOWRITE,nid)
+  IF (ierr.NE.NF90_NOERR) THEN
     write(*,*)'Problem opening spsc_albedo.nc (phymars/albedocaps.F90)'
     write(*,*)'It should be in :',trim(datafile),'/'
@@ -220,19 +244,37 @@
     write(*,*)'   http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
     CALL ABORT
+  ELSE
+    write(*,*) "albedocaps: using file ",trim(datafile)//"/spsc_albedo.nc"
   ENDIF
 
-  ierr=NF_INQ_VARID(nid,"latitude",nvarid)
-  if (ierr.ne.NF_NOERR) then
+  ierr=nf90_inq_varid(nid,"latitude",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find latitude in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESlats)
-  endif
-
-  ierr=NF_INQ_VARID(nid,"albedo",nvarid)
-  if (ierr.ne.NF_NOERR) then
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESlats)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading latitude data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+
+  ierr=nf90_inq_varid(nid,"albedo",nvarid)
+  if (ierr.ne.NF90_NOERR) then
     write(*,*) "Failed to find albedo in file!"
-  else
-    ierr=NF_GET_VAR_REAL(nid,nvarid,TESalbs)
-  endif
+    write(*,*)trim(nf90_strerror(ierr))
+    stop
+  else
+    ierr=nf90_get_var(nid,nvarid,TESalbs)
+    if (ierr.ne.NF90_NOERR) then
+      write(*,*) "Failed loading albedo data from file!"
+      write(*,*)trim(nf90_strerror(ierr))
+      stop
+    endif
+  endif
+
+  ierr=nf90_close(nid)
 
 ! constants:
Index: trunk/LMDZ.MARS/libf/phymars/co2snow.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/co2snow.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/co2snow.F	(revision 1130)
@@ -3,4 +3,5 @@
 
       use surfdat_h, only: iceradius, dtemisice
+      use comgeomfi_h, only: lati ! grid point latitudes (rad)
       IMPLICIT NONE
 
@@ -107,8 +108,8 @@
 c   dtemis: Time scale for increasing the ice emissivity
 
-           IF(ig.GT.ngrid/2+1) THEN
-              icap=2
+           IF(lati(ig).LT. 0.) THEN
+              icap=2 ! Southern hemisphere
            ELSE
-              icap=1
+              icap=1 ! Northern Hemisphere
            ENDIF
 
Index: trunk/LMDZ.MARS/libf/phymars/comgeomfi_h.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/comgeomfi_h.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/comgeomfi_h.F90	(revision 1130)
@@ -5,5 +5,7 @@
 
        ! These arrays are allocated in inifis
-       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: long,lati,area
+       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: long ! longitudes (rad)
+       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: lati ! latitudes (rad)
+       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: area ! mesh area (m2)
        REAL,SAVE :: totarea
 
Index: trunk/LMDZ.MARS/libf/phymars/comgeomphy.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/comgeomphy.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/comgeomphy.F90	(revision 1130)
@@ -0,0 +1,23 @@
+module comgeomphy
+   real,save,allocatable :: airephy(:)
+   real,save,allocatable :: cuphy(:)
+   real,save,allocatable :: cvphy(:)
+   real,save,allocatable :: rlatd(:)
+   real,save,allocatable :: rlond(:)
+!$OMP THREADPRIVATE(airephy,cuphy,cvphy,rlatd,rlond)
+contains
+  
+  subroutine initcomgeomphy
+  USE mod_phys_lmdz_para, only: klon_omp
+  implicit none
+    
+ 
+    allocate(airephy(klon_omp))
+    allocate(cuphy(klon_omp))
+    allocate(cvphy(klon_omp))
+    allocate(rlatd(klon_omp))
+    allocate(rlond(klon_omp))
+
+  end subroutine initcomgeomphy
+  
+end module comgeomphy
Index: trunk/LMDZ.MARS/libf/phymars/datareadnc.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/datareadnc.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/datareadnc.F	(revision 1130)
@@ -99,5 +99,5 @@
 
 
-#include "lmdstd.h"
+!#include "lmdstd.h"
 #include "fxyprim.h"
 
Index: trunk/LMDZ.MARS/libf/phymars/dimphy.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dimphy.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/dimphy.F90	(revision 1130)
@@ -0,0 +1,32 @@
+MODULE dimphy
+  
+  INTEGER,SAVE :: klon   ! number of atmospheric columns (for this OpenMP subgrid)
+  INTEGER,SAVE :: klev   ! number of atmospheric layers
+  INTEGER,SAVE :: klevp1 ! number of atmospheric layers+1
+  INTEGER,SAVE :: klevm1 ! number of atmospheric layers-1
+!  INTEGER,SAVE :: kflev
+
+!$OMP THREADPRIVATE(klon)
+
+CONTAINS
+  
+  SUBROUTINE Init_dimphy(klon0,klev0)
+  IMPLICIT NONE
+  
+    INTEGER, INTENT(in) :: klon0
+    INTEGER, INTENT(in) :: klev0
+    
+    klon=klon0
+    
+!$OMP MASTER 
+    klev=klev0
+    klevp1=klev+1
+    klevm1=klev-1
+!    kflev=klev
+!$OMP END MASTER    
+!$OMP BARRIER
+    
+  END SUBROUTINE Init_dimphy
+
+  
+END MODULE dimphy
Index: trunk/LMDZ.MARS/libf/phymars/eofdump_mod.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/eofdump_mod.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/eofdump_mod.F90	(revision 1130)
@@ -27,9 +27,9 @@
       integer,intent(in) :: ngrid ! total number of physics grid points
       integer,intent(in) :: nlayer ! number of atmospheric layers
-      real*4 u(ngrid,nlayer)
-      real*4 v(ngrid,nlayer)
-      real*4 t(ngrid,nlayer)
-      real*4 rho(ngrid,nlayer)
-      real*4 ps(ngrid)
+      real,intent(in) :: u(ngrid,nlayer)
+      real,intent(in) :: v(ngrid,nlayer)
+      real,intent(in) :: t(ngrid,nlayer)
+      real,intent(in) :: rho(ngrid,nlayer)
+      real,intent(in) :: ps(ngrid)
       integer,save :: count=0
       integer i,j,l, ig
@@ -56,4 +56,11 @@
           do j=1+eofskip/2,jjm+1,eofskip
             ig = 1+ (j-2)*iim +i
+#ifdef NC_DOUBLE
+            write(uedata) (real(u(ig,l)),l=1,nlayer)
+            write(uedata) (real(v(ig,l)),l=1,nlayer)
+            write(uedata) (real(t(ig,l)),l=1,nlayer)
+            write(uedata) (real(rho(ig,l)),l=1,nlayer)
+            write(uedata) real(ps(ig))
+#else
             write(uedata) (u(ig,l),l=1,nlayer)
             write(uedata) (v(ig,l),l=1,nlayer)
@@ -61,4 +68,5 @@
             write(uedata) (rho(ig,l),l=1,nlayer)
             write(uedata) ps(ig)
+#endif
           enddo
         enddo
@@ -112,11 +120,20 @@
           if(j.eq.1) stop 'Problem in ineofdump.F'
           if(j.eq.jjm+1) stop 'Problem in ineofdump.F'
+#ifdef NC_DOUBLE
+          write(uehead,*) real(long(ig)*180./pi),real(lati(ig)*180./pi)
+#else
           write(uehead,*) long(ig)*180./pi, lati(ig)*180./pi
+#endif
 !         write(*,*) 'eof grid j=',j,' lat= ', lati(ig)*180./pi
         enddo
       enddo
 
+#ifdef NC_DOUBLE
+      write(uehead,*) real(aps)
+      write(uehead,*) real(bps)
+#else
       write(uehead,*) aps
       write(uehead,*) bps
+#endif
       close(uehead)
 !
Index: trunk/LMDZ.MARS/libf/phymars/inifis.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/inifis.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/inifis.F	(revision 1130)
@@ -59,4 +59,5 @@
       use yomlw_h, only: ini_yomlw_h
       use conc_mod, only: ini_conc_mod
+      use control_mod, only: ecritphy
 
 #ifdef MESOSCALE
@@ -136,4 +137,8 @@
 !      ENDIF
 
+      ! read in 'ecritphy' (frequency of calls to physics, in dynamical steps)
+      ! (also done in dyn3d/defrun_new but not in LMDZ.COMMON)
+      call getin("ecritphy",ecritphy)
+      
 ! --------------------------------------------------------------
 !  Reading the "callphys.def" file controlling some key options
Index: trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90	(revision 1130)
@@ -0,0 +1,77 @@
+subroutine iniphysiq(ngrid,nlayer, punjours, pdayref,ptimestep,          &
+                     plat,plon,parea,pcu,pcv,                            &
+                     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 : 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
+
+implicit none
+
+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
+real,intent(in) :: plat(ngrid) ! latitudes of the physics grid
+real,intent(in) :: plon(ngrid) ! longitudes of the physics grid
+real,intent(in) :: parea(klon_glo) ! area (m2)
+real,intent(in) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
+integer,intent(in) :: pdayref ! reference day of for the simulation
+real,intent(in) :: ptimestep !physics time step (s)
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: ibegin,iend,offset
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+
+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
+
+!$OMP PARALLEL PRIVATE(ibegin,iend) 
+!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+offset=klon_mpi_begin-1
+airephy(1:klon_omp)=parea(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call inifis(klon_omp,nlayer,nqtot,pdayref,punjours,ptimestep, &
+            rlatd,rlond,airephy,prad,pg,pr,pcpp)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: trunk/LMDZ.MARS/libf/phymars/inistats.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/inistats.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/inistats.F	(revision 1130)
@@ -1,4 +1,5 @@
       subroutine inistats(ierr)
 
+      use mod_phys_lmdz_para, only : is_master
       implicit none
 
@@ -42,4 +43,7 @@
          pseudoalt(l)=-10.*log(presnivs(l)/preff)   
       enddo
+
+      if (is_master) then
+      ! only the master needs do this
 
       ierr = NF_CREATE("stats.nc",IOR(NF_CLOBBER,NF_64BIT_OFFSET),nid)
@@ -110,4 +114,5 @@
       ierr=NF_CLOSE(nid)
 
+      endif ! of if (is_master)
       end subroutine inistats
 
Index: trunk/LMDZ.MARS/libf/phymars/init_phys_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/init_phys_lmdz.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/init_phys_lmdz.F90	(revision 1130)
@@ -0,0 +1,27 @@
+!
+! $Id$
+!
+SUBROUTINE init_phys_lmdz(iim,jjp1,llm,nb_proc,distrib)
+  USE mod_phys_lmdz_omp_data, only: klon_omp
+  USE mod_grid_phy_lmdz, only: nbp_lev
+  USE mod_phys_lmdz_para, only: init_phys_lmdz_para
+  USE mod_grid_phy_lmdz, only: init_grid_phy_lmdz
+  USE dimphy, ONLY : init_dimphy
+
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: llm
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+
+    CALL init_grid_phy_lmdz(iim,jjp1,llm)
+    CALL init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL init_dimphy(klon_omp,nbp_lev)
+
+!$OMP END PARALLEL
+ 
+END SUBROUTINE init_phys_lmdz  
Index: trunk/LMDZ.MARS/libf/phymars/initracer.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/initracer.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/initracer.F	(revision 1130)
@@ -2,5 +2,5 @@
 
 #ifndef MESOSCALE
-       use infotrac, only: tnom
+       use infotrac, only: tname
 #endif
        use tracer_mod
@@ -81,5 +81,5 @@
         txt=" "
         write(txt,'(a1,i2.2)') 'q',iq
-        if (txt.eq.tnom(iq)) then
+        if (txt.eq.tname(iq)) then
           count=count+1
         endif
@@ -95,5 +95,5 @@
       ! copy tracer names from dynamics
       do iq=1,nq
-        noms(iq)=tnom(iq)
+        noms(iq)=tname(iq)
       enddo
 #endif
Index: trunk/LMDZ.MARS/libf/phymars/iostart.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/iostart.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/iostart.F90	(revision 1130)
@@ -0,0 +1,968 @@
+MODULE iostart
+
+    IMPLICIT NONE
+PRIVATE
+    INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
+    INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
+    
+    ! restartfi.nc file dimension identifiers: (see open_restartphy())
+    INTEGER,SAVE :: idim1 ! "index" dimension
+    INTEGER,SAVE :: idim2 ! "physical_points" dimension
+    INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
+    INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
+    INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
+    INTEGER,SAVE :: idim6 ! "nlayer" dimension
+    INTEGER,SAVE :: idim7 ! "Time" dimension
+    INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
+    INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
+    
+    INTERFACE get_field
+      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
+    END INTERFACE get_field
+    
+    INTERFACE get_var
+      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
+    END INTERFACE get_var
+
+    INTERFACE put_field
+      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
+    END INTERFACE put_field
+
+    INTERFACE put_var
+      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
+    END INTERFACE put_var
+
+    PUBLIC nid_start, length
+    PUBLIC get_field,get_var,put_field,put_var
+    PUBLIC inquire_dimension, inquire_dimension_length
+    PUBLIC inquire_field, inquire_field_ndims
+    PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
+    
+CONTAINS
+
+  SUBROUTINE open_startphy(filename)
+  USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+      ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'open_startphy: problem opening file '//trim(filename)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+    
+    CALL bcast(nid_start) ! tell all procs about nid_start
+  
+  END SUBROUTINE open_startphy
+
+  SUBROUTINE close_startphy
+  USE netcdf, only: NF90_CLOSE
+  USE mod_phys_lmdz_para, only: is_master
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+        ierr = NF90_CLOSE (nid_start)
+    ENDIF
+
+  END SUBROUTINE close_startphy
+
+
+  FUNCTION inquire_field(Field_name)
+  ! check if a given field is present in the input file
+  USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    LOGICAL :: inquire_field
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      IF (ierr==NF90_NOERR) THEN
+        Inquire_field=.TRUE.
+      ELSE
+        Inquire_field=.FALSE.
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_field)
+
+  END FUNCTION inquire_field
+
+
+  FUNCTION inquire_field_ndims(Field_name)
+  ! give the number of dimensions of "Field_name" stored in the input file 
+  USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
+                    NF90_NOERR, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    INTEGER :: inquire_field_ndims
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=nf90_inq_varid(nid_start,Field_name,varid)
+      ierr=nf90_inquire_variable(nid_start,varid,&
+                                  ndims=inquire_field_ndims)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'inquire_field_ndims: problem obtaining ndims of '&
+                  //trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_field_ndims)
+
+  END FUNCTION inquire_field_ndims
+
+
+  FUNCTION inquire_dimension(Field_name)
+  ! check if a given dimension is present in the input file
+  USE netcdf, only: nf90_inq_dimid, NF90_NOERR
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    LOGICAL :: inquire_dimension
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
+      IF (ierr==NF90_NOERR) THEN
+        Inquire_dimension=.TRUE.
+      ELSE
+        Inquire_dimension=.FALSE.
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_dimension)
+
+  END FUNCTION inquire_dimension
+
+  FUNCTION inquire_dimension_length(Field_name)
+  ! give the length of the "Field_name" dimension stored in the input file
+  USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
+                    NF90_NOERR, nf90_strerror
+  USE mod_phys_lmdz_para, only: is_master, bcast
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Field_name
+    INTEGER :: inquire_dimension_length
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+      ierr=nf90_inq_dimid(nid_start,Field_name,varid)
+      ierr=nf90_inquire_dimension(nid_start,varid,&
+                                  len=inquire_dimension_length)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(*,*)'inquire_field_length: problem obtaining length of '&
+                  //trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+    CALL bcast(inquire_dimension_length)
+
+  END FUNCTION inquire_dimension_length
+
+
+
+  SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
+  ! For a surface field
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2:4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(2)=timeindex
+    endif
+
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,1,corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,1,corners,edges)
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r1
+  
+  SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
+  ! For a "3D" horizontal-vertical field
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2)=size(field,2)
+    edges(3:4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(3)=timeindex
+    endif
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2),&
+                          corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2),&
+                          corners,edges)
+    ENDIF
+
+      
+  END SUBROUTINE Get_Field_r2
+  
+  SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
+  ! for a "4D" field surf/alt/??
+  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
+
+    integer :: edges(4), corners(4)
+
+    edges(1)=klon_glo
+    edges(2)=size(field,2)
+    edges(3)=size(field,3)
+    edges(4)=1
+    corners(1:4)=1
+    if (PRESENT(timeindex)) then
+      corners(4)=timeindex
+    endif
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
+                          corners,edges,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
+                          corners,edges)
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r3
+  
+  SUBROUTINE Get_field_rgen(field_name,field,field_size, &
+                            corners,edges,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: Field_name
+    INTEGER          :: field_size
+    REAL             :: field(klon,field_size)
+    INTEGER,INTENT(IN) :: corners(4)
+    INTEGER,INTENT(IN) :: edges(4)
+    LOGICAL,OPTIONAL :: found
+    
+    REAL    :: field_glo(klon_glo,field_size)
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_master) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        CALL body(field_glo)
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL scatter(field_glo,field)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'get_field_rgen: Field <'//field_name//'> not found'
+        CALL abort
+      ENDIF
+    ENDIF
+ 
+    
+    CONTAINS
+     
+     SUBROUTINE body(field_glo)
+       REAL :: field_glo(klon_glo*field_size)
+         ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
+         IF (ierr/=NF90_NOERR) THEN
+           ! La variable exist dans le fichier mais la lecture a echouee. 
+           PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
+
+!           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
+!              ! Essaye de lire le variable sur surface uniqument, comme fait avant
+!              field_glo(:)=0.
+!              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
+!              IF (ierr/=NF90_NOERR) THEN
+!                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
+!                 CALL abort
+!              ELSE
+!                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
+!              END IF
+!           ELSE
+              CALL abort
+!           ENDIF
+         ENDIF
+
+     END SUBROUTINE body
+
+  END SUBROUTINE Get_field_rgen
+
+
+  SUBROUTINE get_var_r0(var_name,var,found)
+  ! Get a scalar from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+
+    REAL                         :: varout(1)
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,varout,size(varout),found)
+    ELSE
+      CALL Get_var_rgen(var_name,varout,size(varout))
+    ENDIF
+    var=varout(1)
+ 
+  END SUBROUTINE get_var_r0
+
+  SUBROUTINE get_var_r1(var_name,var,found)
+  ! Get a vector from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r1
+
+  SUBROUTINE get_var_r2(var_name,var,found)
+  ! Get a 2D field from input file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(OUT)             :: var(:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r2
+
+  SUBROUTINE get_var_r3(var_name,var,found)
+  ! Get a 3D field frominput file
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:,:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r3
+
+  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: var_name
+    INTEGER          :: var_size
+    REAL             :: var(var_size)
+    LOGICAL,OPTIONAL :: found
+    
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        ierr=NF90_GET_VAR(nid_start,varid,var)
+        IF (ierr/=NF90_NOERR) THEN
+          PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>'
+          CALL abort
+        ENDIF
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL bcast(var)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found'
+        CALL abort
+      ENDIF
+    ENDIF
+
+  END SUBROUTINE Get_var_rgen
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE open_restartphy(filename)
+  USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
+                    NF90_NOERR, nf90_strerror, &
+                    NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
+                    NF90_UNLIMITED, NF90_ENDDEF, &
+                    NF90_WRITE, NF90_OPEN
+  USE mod_phys_lmdz_para, only: is_master
+  USE mod_grid_phy_lmdz, only: klon_glo
+  USE dimphy, only: klev, klevp1
+  USE infotrac, only: nqtot
+  USE comsoil_h, only: nsoilmx
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    INTEGER                     :: ierr
+    LOGICAL,SAVE :: already_created=.false.
+    
+    IF (is_master) THEN
+      if (.not.already_created) then
+        ! At the very first call, create the file
+        ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
+                          nid_restart)
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'open_restartphy: problem creating file '//trim(filename)
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        already_created=.true.
+      else
+        ! Just open the file
+        ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'open_restartphy: problem opening file '//trim(filename)
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        return
+      endif ! of if (.not.already_created)
+
+      ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
+                        "Physics start file")
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem writing title '
+        write(*,*)trim(nf90_strerror(ierr))
+      ENDIF
+
+      ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining index dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining physical_points dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining subsurface_layers dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining nlayer_plus_1 dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqtot,idim5)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining number_of_advected_fields dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+
+      ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining nlayer dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+      
+      ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem defining Time dimension '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+
+      ierr=NF90_ENDDEF(nid_restart)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'open_restartphy: problem ending definition mode '
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF
+
+  END SUBROUTINE open_restartphy
+
+  SUBROUTINE close_restartphy
+  USE netcdf, only: NF90_CLOSE
+  USE mod_phys_lmdz_para, only: is_master
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_master) THEN
+      ierr = NF90_CLOSE (nid_restart)
+    ENDIF
+ 
+  END SUBROUTINE close_restartphy
+
+  SUBROUTINE put_field_r1(field_name,title,field,time)
+  ! For a surface field
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,1,time)
+  ELSE
+    CALL put_field_rgen(field_name,title,field,1)
+  ENDIF
+  
+  END SUBROUTINE put_field_r1
+
+  SUBROUTINE put_field_r2(field_name,title,field,time)
+  ! For a "3D" horizontal-vertical field
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,size(field,2),time)
+  ELSE
+    CALL put_field_rgen(field_name,title,field,size(field,2))
+  ENDIF
+  
+  END SUBROUTINE put_field_r2
+
+  SUBROUTINE put_field_r3(field_name,title,field,time)
+  ! For a "4D" field surf/alt/??
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:,:)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  IF (present(time)) THEN
+    ! if timeindex is present, it is a time-dependent variable
+    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
+                        time)
+  ELSE  
+    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
+  ENDIF
+  
+  END SUBROUTINE put_field_r3
+  
+  SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
+  USE netcdf
+  USE dimphy
+  USE comsoil_h, only: nsoilmx
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  INTEGER,INTENT(IN)             :: field_size
+  REAL,INTENT(IN)                :: field(klon,field_size)
+  REAL,OPTIONAL,INTENT(IN)       :: time
+  
+  REAL                           :: field_glo(klon_glo,field_size)
+  INTEGER                        :: ierr
+  INTEGER                        :: nvarid
+  INTEGER                        :: idim
+   
+    CALL gather(field,field_glo)
+    
+    IF (is_master) THEN
+
+      IF (field_size==1) THEN
+        ! input is a 1D "surface field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,timeindex/))
+        endif ! of if (.not.present(timeindex))
+
+      ELSE IF (field_size==klev) THEN
+        ! input is a 2D "atmospheric field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim6/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim6/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim6,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim6,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+        endif ! of if (.not.present(time))
+
+      ELSE IF (field_size==klevp1) THEN
+        ! input is a 2D "interlayer atmospheric field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim4/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim4/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr = NF90_ENDDEF(nid_restart)
+          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim4,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim4,idim7/),nvarid)
+#endif
+            if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+        endif ! of if (.not.present(timeindex))
+
+      ELSE IF (field_size==nsoilmx) THEN
+        ! input is a 2D "subsurface field" array
+        if (.not.present(time)) then ! for a time-independent field
+          ierr = NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                            (/idim2,idim3/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                            (/idim2,idim3/),nvarid)
+#endif
+          if (ierr.ne.NF90_NOERR) then
+            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+            write(*,*)trim(nf90_strerror(ierr))
+          endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr = NF90_ENDDEF(nid_restart)
+          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
+        else
+          ! check if the variable has already been defined:
+          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
+          if (ierr/=NF90_NOERR) then ! variable not found, define it
+            ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
+                              (/idim2,idim3,idim7/),nvarid)
+#else
+            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
+                              (/idim2,idim3,idim7/),nvarid)
+#endif
+           if (ierr.ne.NF90_NOERR) then
+              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
+              write(*,*)trim(nf90_strerror(ierr))
+            endif
+            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+            ierr=NF90_ENDDEF(nid_restart)
+          endif
+          ! Write the variable
+          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
+                            start=(/1,1,timeindex/))
+
+        endif ! of if (.not.present(time))
+
+      ELSE
+        PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
+        write(*,*) "  field_size =",field_size
+        CALL ABORT
+      ENDIF
+
+      ! Check the writting of field to file went OK
+      if (ierr.ne.NF90_NOERR) then
+        write(*,*) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        call abort
+      endif
+
+    ENDIF ! of IF (is_master)
+    
+  END SUBROUTINE put_field_rgen  
+  
+  SUBROUTINE put_var_r0(var_name,title,var)
+  ! Put a scalar in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var
+     REAL                        :: varin(1)
+     
+     varin(1)=var
+     
+     CALL put_var_rgen(var_name,title,varin,size(varin))
+
+  END SUBROUTINE put_var_r0
+
+
+  SUBROUTINE put_var_r1(var_name,title,var)
+  ! Put a vector in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r1
+ 
+  SUBROUTINE put_var_r2(var_name,title,var)
+  ! Put a 2D field in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r2     
+  
+  SUBROUTINE put_var_r3(var_name,title,var)
+  ! Put a 3D field in file
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r3
+
+  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
+  USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
+                    NF90_FLOAT, NF90_DOUBLE, NF90_DEF_VAR, &
+                    NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
+                    nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
+  USE comsoil_h, only: nsoilmx
+  USE mod_phys_lmdz_para, only: is_master
+  IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     INTEGER,INTENT(IN)          :: var_size
+     REAL,INTENT(IN)             :: var(var_size)
+     
+     INTEGER :: ierr
+     INTEGER :: nvarid
+     INTEGER :: idim1d
+     logical,save :: firsttime=.true.
+         
+    IF (is_master) THEN
+
+      IF (var_name=="Time") THEN
+        ! Very specific case of "Time" variable
+        if (firsttime) then
+          ! Create the "Time variable"
+          ierr=NF90_REDEF(nid_restart)
+#ifdef NC_DOUBLE
+          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
+                            (/idim7/),nvarid)
+#else
+          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
+                            (/idim7/),nvarid)
+#endif
+          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+          ierr=NF90_ENDDEF(nid_restart)
+          
+          firsttime=.false.
+        endif
+        ! Append "time" value
+        ! get current length of "Time" dimension
+        ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
+        ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
+        timeindex=timeindex+1
+        ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
+        ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
+                           start=(/timeindex/))
+        IF (ierr/=NF90_NOERR) THEN
+          write(*,*)'put_var_rgen: problem writing Time'
+          write(*,*)trim(nf90_strerror(ierr))
+          CALL ABORT
+        ENDIF
+        return ! nothing left to do
+      ELSEIF (var_size==length) THEN
+        ! We know it is a "controle" kind of 1D array
+        idim1d=idim1
+      ELSEIF (var_size==nsoilmx) THEN
+        ! We know it is an  "mlayer" kind of 1D array
+        idim1d=idim3
+      ELSE 
+        PRINT *, "put_var_rgen error : wrong dimension"
+        write(*,*) "  var_size =",var_size
+        CALL abort
+
+      ENDIF ! of IF (var_size==length) THEN
+
+      ! Swich to NetCDF define mode
+      ierr=NF90_REDEF (nid_restart)
+      ! Define the variable
+#ifdef NC_DOUBLE
+      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
+#else
+      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
+#endif
+      ! Add a "title" attribute
+      IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
+      ! Swich out of define mode
+      ierr=NF90_ENDDEF(nid_restart)
+      ! Write variable to file
+      ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
+      IF (ierr/=NF90_NOERR) THEN
+        write(*,*)'put_var_rgen: problem writing '//trim(var_name)
+        write(*,*)trim(nf90_strerror(ierr))
+        CALL ABORT
+      ENDIF
+    ENDIF ! of IF (is_master)
+    
+  END SUBROUTINE put_var_rgen     
+
+END MODULE iostart
Index: trunk/LMDZ.MARS/libf/phymars/ismax.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/ismax.F	(revision 1127)
+++ 	(revision )
@@ -1,20 +1,0 @@
-      function ismax(n,sx,incx)
-c
-      IMPLICIT NONE
-c
-      INTEGER n,i,incx,ismax,ix
-      real sx((n-1)*incx+1),sxmax
-c
-      ix=1
-      ismax=1
-      sxmax=sx(1)
-      do 10 i=1,n-1
-      ix=ix+incx
-      if(sx(ix).gt.sxmax) then
-      sxmax=sx(ix)
-      ismax=i+1
-         endif
-10    continue
-c
-      return
-      end
Index: trunk/LMDZ.MARS/libf/phymars/ismin.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/ismin.F	(revision 1127)
+++ 	(revision )
@@ -1,20 +1,0 @@
-      FUNCTION ismin(n,sx,incx)
-c
-      IMPLICIT NONE
-c
-      integer n,i,incx,ismin,ix
-      real sx((n-1)*incx+1),sxmin
-c
-      ix=1
-      ismin=1
-      sxmin=sx(1)
-      DO i=1,n-1
-      ix=ix+incx
-      if(sx(ix).lt.sxmin) then
-        sxmin=sx(ix)
-        ismin=i+1
-      endif
-      ENDDO
-c
-      return
-      end
Index: trunk/LMDZ.MARS/libf/phymars/mkstat.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mkstat.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/mkstat.F90	(revision 1130)
@@ -10,4 +10,5 @@
 !  Yann W. july 2003
 
+use mod_phys_lmdz_para, only : is_master
 
 implicit none
@@ -36,4 +37,7 @@
 ! Incrementation of count for the last step, which is not done in wstats
 count(istime)=count(istime)+1
+
+if (is_master) then
+! only the master needs do this
 
 ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
@@ -162,3 +166,5 @@
 ierr= NF_CLOSE(nid)
 
+endif ! of if (is_master)
+
 end
Index: trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90	(revision 1130)
@@ -0,0 +1,453 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90	(revision 1130)
@@ -0,0 +1,211 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+       klon_glo=iim*(jjp1-2)+2
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h" 
+  
+    WRITE(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90	(revision 1130)
@@ -0,0 +1,1906 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_transfert
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+		     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_mpi
+    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+		     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D_mpi
+    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+		     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+		     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum_mpi
+    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE 
+
+ INTERFACE grid1dTo2d_mpi
+    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
+                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
+		     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
+ END INTERFACE 
+
+ INTERFACE grid2dTo1d_mpi
+    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
+                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
+		     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
+ END INTERFACE 
+    
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL scatter_mpi_igen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
+    
+  END SUBROUTINE scatter_mpi_i1
+  
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,1)
+  
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_r1
+  
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_l1
+  
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_i
+  
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i2
+  
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_R
+
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r1
+
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r2
+  
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_r3
+  
+  
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l
+
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE scatter2D_mpi_l1
+
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+  
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l2
+  
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i2
+  
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+ 
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i3
+
+
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r2
+  
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r3
+
+  
+  
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l2
+  
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i4                  
+  
+  
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+     
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r4 
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_i
+  
+
+  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i1
+
+  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i2
+  
+  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i3
+
+
+  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_r
+  
+
+  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r1
+
+  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r2
+  
+  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_l
+  
+
+  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l1
+
+  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l2
+  
+  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l3
+
+
+  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_i
+  
+
+  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i1
+
+  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i2
+  
+  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_r
+  
+
+  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r1
+
+  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r2
+  
+  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r3
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_l
+  
+
+  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l1
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l2
+
+  
+  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l3
+
+               
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+    
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
+    if (ierr.ne.MPI_SUCCESS) then
+      write(*,*) "bcast_mpi error: ierr=",ierr
+      stop
+    endif
+#endif
+
+  END SUBROUTINE bcast_mpi_lgen
+
+  
+
+  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
+                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_igen
+
+  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+
+#endif
+
+  END SUBROUTINE scatter_mpi_rgen
+
+  
+  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_lgen  
+
+
+
+
+  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+     
+    ENDIF
+    
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
+                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_igen  
+
+  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_rgen  
+
+  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_lgen
+  
+
+
+  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+   
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+   
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+
+
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+            
+  END SUBROUTINE reduce_sum_mpi_igen
+  
+  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+
+    IMPLICIT NONE
+
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+ 
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+   
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE reduce_sum_mpi_rgen
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE grid1dTo2d_mpi_igen   
+
+
+  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_rgen   
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=.FALSE.
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_lgen   
+
+  
+
+
+  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_igen   
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+         VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_rgen   
+  
+
+  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_lgen   
+
+END MODULE mod_phys_lmdz_mpi_transfert
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90	(revision 1130)
@@ -0,0 +1,109 @@
+!
+!$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas $
+!
+MODULE mod_phys_lmdz_omp_data
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_using_omp
+  
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
+  
+  INTEGER,SAVE :: klon_omp
+  INTEGER,SAVE :: klon_omp_begin
+  INTEGER,SAVE :: klon_omp_end
+!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi)
+    USE dimphy
+    IMPLICIT NONE
+    INTEGER, INTENT(in) :: klon_mpi
+
+    INTEGER :: i
+
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
+#ifdef CPP_OMP    
+    INTEGER :: OMP_GET_NUM_THREADS
+    EXTERNAL OMP_GET_NUM_THREADS
+    INTEGER :: OMP_GET_THREAD_NUM
+    EXTERNAL OMP_GET_THREAD_NUM
+#endif  
+
+#ifdef CPP_OMP
+!$OMP MASTER
+        is_using_omp=.TRUE.
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+    is_using_omp=.FALSE.
+    omp_size=1
+    omp_rank=0
+#endif
+
+   is_omp_root=.FALSE.
+!$OMP MASTER
+   IF (omp_rank==0) THEN
+     is_omp_root=.TRUE.
+   ELSE
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
+   ENDIF
+!$OMP END MASTER
+
+
+!$OMP MASTER 
+    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
+    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
+    ALLOCATE(klon_omp_para_end(0:omp_size-1))
+    
+    DO i=0,omp_size-1
+      klon_omp_para_nb(i)=klon_mpi/omp_size
+      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
+    ENDDO
+    
+    klon_omp_para_begin(0) = 1
+    klon_omp_para_end(0) = klon_omp_para_nb(0)
+    
+    DO i=1,omp_size-1
+      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
+      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+   
+    klon_omp=klon_omp_para_nb(omp_rank)
+    klon_omp_begin=klon_omp_para_begin(omp_rank)
+    klon_omp_end=klon_omp_para_end(omp_rank)
+    
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_omp_data
+
+  SUBROUTINE Print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h"
+
+!$OMP CRITICAL  
+  WRITE(*,*)'--------> TASK ',omp_rank
+  WRITE(*,*)'omp_size =',omp_size
+  WRITE(*,*)'omp_rank =',omp_rank
+  WRITE(*,*)'is_omp_root =',is_omp_root
+  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(*,*)'klon_omp =',klon_omp
+  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(*,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90	(revision 1130)
@@ -0,0 +1,1057 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_omp_transfert
+
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+		     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_omp
+    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+		     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+  
+  
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE scatter_omp_i
+
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
+    
+  END SUBROUTINE scatter_omp_i1
+  
+  
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
+
+  END SUBROUTINE scatter_omp_i2
+
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
+  
+  END SUBROUTINE scatter_omp_i3
+
+
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE scatter_omp_r
+
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
+        
+  END SUBROUTINE scatter_omp_r1
+  
+  
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
+
+  END SUBROUTINE scatter_omp_r2
+
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
+  
+  END SUBROUTINE scatter_omp_r3
+  
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE scatter_omp_l
+
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
+    
+  END SUBROUTINE scatter_omp_l1
+  
+  
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
+
+  END SUBROUTINE scatter_omp_l2
+
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
+  
+  END SUBROUTINE scatter_omp_l3  
+  
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
+    
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
+          
+  END SUBROUTINE gather_omp_i2
+  
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
+    
+  END SUBROUTINE gather_omp_i3
+
+
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+        
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    
+  END SUBROUTINE gather_omp_r2
+  
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))       
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
+    
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
+    
+  END SUBROUTINE gather_omp_l2
+  
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
+    
+  END SUBROUTINE gather_omp_l3
+
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+
+
+  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+    USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+ 
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+ 
+  END SUBROUTINE scatter_omp_igen
+
+
+  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_rgen
+
+
+  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+ !$OMP MASTER 
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_lgen
+
+
+
+
+
+  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_igen
+
+
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_lgen
+
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+END MODULE mod_phys_lmdz_omp_transfert
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90	(revision 1130)
@@ -0,0 +1,114 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_para
+  USE mod_phys_lmdz_transfert_para
+  USE mod_phys_lmdz_mpi_data
+  USE mod_phys_lmdz_omp_data
+    
+  INTEGER,SAVE :: klon_loc
+  LOGICAL,SAVE :: is_sequential
+  LOGICAL,SAVE :: is_parallel
+  LOGICAL,SAVE :: is_master
+  
+!$OMP THREADPRIVATE(klon_loc,is_master)
+  
+CONTAINS
+
+  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL Init_phys_lmdz_omp_data(klon_mpi)
+    klon_loc=klon_omp
+    IF (is_mpi_root .AND. is_omp_root) THEN 
+       is_master=.TRUE.
+     ELSE
+       is_master=.FALSE.
+     ENDIF
+     CALL Test_transfert
+!$OMP END PARALLEL    
+     IF (is_using_mpi .OR. is_using_omp) THEN
+       is_sequential=.FALSE.
+       is_parallel=.TRUE.
+     ELSE
+       is_sequential=.TRUE.
+       is_parallel=.FALSE.
+     ENDIF
+      
+  END SUBROUTINE Init_phys_lmdz_para
+
+  SUBROUTINE Test_transfert
+  USE mod_grid_phy_lmdz, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
+                               grid1dTo2d_glo, grid2dTo1d_glo
+  IMPLICIT NONE
+!    INCLUDE "iniprint.h"
+ 
+    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
+    REAL :: tmp1d_glo(klon_glo,nbp_lev)
+    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
+    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
+    REAL :: CheckSum
+    
+    INTEGER :: i,l
+  
+    Test_Field1d_glo = 0.
+    Test_Field2d_glo = 0.
+    Test_Field1d_loc = 0.
+    Test_Field2d_loc = 0.
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER
+      DO l=1,nbp_lev
+        DO i=1,klon_glo
+!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
+           Test_Field1d_glo(i,l)=1
+        ENDDO
+      ENDDO
+!$OMP END MASTER  
+    ENDIF
+  
+    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
+    CALL Gather(Test_Field1d_loc,tmp1d_glo)
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
+    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
+    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
+    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+
+    CALL bcast(Test_Field1d_glo)
+    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90	(revision 1130)
@@ -0,0 +1,1275 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_transfert_para
+
+  USE mod_phys_lmdz_mpi_transfert
+  USE mod_phys_lmdz_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i
+
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i1
+  
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i2  
+
+
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i3
+  
+
+!!!!! --> Les reels
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r
+
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r1
+  
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r2  
+
+
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r3
+    
+    
+!!!!! --> Les booleens
+
+
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l
+
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l1
+  
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l2  
+
+
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i
+  
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i1
+
+  
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i2
+
+
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r
+  
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r1
+
+  
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r2
+
+
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r3
+  
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l
+  
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l1
+
+  
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l2
+
+
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l3
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_phys_lmdz_transfert_para
+
Index: trunk/LMDZ.MARS/libf/phymars/newcondens.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/newcondens.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/newcondens.F	(revision 1130)
@@ -217,4 +217,5 @@
       ENDIF ! of IF (firstcall)
       zcpi=1./cpp
+
 c
 c======================================================================
Index: trunk/LMDZ.MARS/libf/phymars/newstart.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/newstart.F	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/newstart.F	(revision 1130)
@@ -0,0 +1,1654 @@
+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=======================================================================
+
+! to use  'getin'
+      use ioipsl_getincom, only: getin 
+      use infotrac, only: iniadvtrac, nqtot, tname
+      use tracer_mod, only: noms, igcm_dust_number, igcm_dust_mass,
+     &                      igcm_ccn_number, igcm_ccn_mass,
+     &                      igcm_h2o_vap, igcm_h2o_ice
+      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
+     &                     albedodat, z0_default
+      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx
+      use control_mod, only: day_step, iphysiq, anneeref
+      use phyredem, only: physdem0, physdem1
+      use iostart, only: open_startphy
+      use comgeomphy, only: initcomgeomphy
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "dimphys.h"
+!#include "surfdat.h"
+!#include "comsoil.h"
+!#include "dimradmars.h"
+!#include "yomaer.h"
+#include "planete.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+!#include "lmdstd.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+#include "serre.h"
+#include "netcdf.inc"
+!#include"advtrac.h"
+!#include"tracer.h"
+#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 size
+      INTEGER length
+      parameter (length = 100)
+      INTEGER tab0
+      INTEGER   NB_ETATMAX
+      parameter (NB_ETATMAX = 100)
+
+      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 tsurf(ngridmx)	! surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL emis(ngridmx)	! surface emissivity
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL q2(ngridmx,nlayermx+1)
+!      REAL rnaturfi(ngridmx)
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      EXTERNAL iniconst,geopot,inigeom
+      integer ierr  !, nbetat
+      integer ismin
+      external ismin
+
+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 :: nq,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
+
+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(qsurf(ngridmx,nqtot))
+      
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+c-----------------------------------------------------------------------
+c 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)=airefi(1)*iim
+      airefi(ngridmx)=airefi(ngridmx)*iim
+
+! also initialize various physics flags/settings which might be needed
+!    (for instance initracer needs to know about some flags, and/or
+!      'datafile' path may be changed by user)
+      call inifis(ngridmx,llm,nqtot,day_ini,daysec,dtphys,
+     &                latfi,lonfi,airefi,rad,g,r,cpp)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.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,
+     &   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)
+        
+        ! 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,co2ice)
+      
+      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(*,*) '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       q=profile : initialize tracer with a given profile
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'freedust') then
+          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) * 1e-3 ! grosso modo
+                if (igcm_dust_mass .ne. 0) 
+     &          q(i,j,l,igcm_dust_mass)=
+     &                q(i,j,l,igcm_dust_mass)   * 1e-3 ! grosso modo
+                if (igcm_ccn_number .ne. 0) 
+     &          q(i,j,l,igcm_ccn_number)=
+     &                q(i,j,l,igcm_ccn_number) * 1e-3 ! grosso modo
+                if (igcm_ccn_mass .ne. 0) 
+     &          q(i,j,l,igcm_ccn_mass)=
+     &                q(i,j,l,igcm_ccn_mass)   * 1e-3 ! grosso modo
+              end do
+            end do
+          end do
+
+         ! 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
+
+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, nq, 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(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      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)
+
+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/~forget/datagcm/datafile'
+        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/phyetat0.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/phyetat0.F	(revision 1127)
+++ 	(revision )
@@ -1,668 +1,0 @@
-      SUBROUTINE phyetat0 (fichnom,tab0,Lmodif,nsoil,ngrid,nlay,nq,
-     .           day_ini,time0,
-     .           tsurf,tsoil,emis,q2,qsurf,co2ice)
-
-      use netcdf
-      use infotrac, only: nqtot, tnom
-      use surfdat_h, only: phisfi, albedodat, z0, z0_default,
-     &                     zmea, zstd, zsig, zgam, zthe
-
-      implicit none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c  Adaptation à Mars : Yann Wanherdrick 
-c Objet: Lecture de l etat initial pour la physique
-! Modifs: Aug.2010 EM : use NetCDF90 to load variables (enables using
-!                      r4 or r8 restarts independently of having compiled
-!                      the GCM in r4 or r8)
-!         June 2013 TN : Possibility to read files with a time axis
-c======================================================================
-!#include "netcdf.inc"
-!#include "dimensions.h"
-!#include "dimphys.h"
-!#include "comgeomfi.h"
-!#include "surfdat.h"
-#include "planete.h"
-!#include "dimradmars.h"
-!#include "yomaer.h"
-#include "comcstfi.h"
-!#include "tracer.h"
-!#include "advtrac.h"
-#include "control.h"
-c======================================================================
-      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
-      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
-!======================================================================
-!  Arguments:
-!  ---------
-!  inputs:
-      character*(*),intent(in) :: fichnom ! "startfi.nc" file
-      integer,intent(in) :: tab0
-      integer,intent(in) :: Lmodif
-      integer,intent(in) :: nsoil ! # of soil layers
-      integer,intent(in) :: ngrid ! # of atmospheric columns
-      integer,intent(in) :: nlay ! # of atmospheric layers
-      integer,intent(in) :: nq
-      integer :: day_ini
-      real :: time0
-
-!  outputs:
-      real,intent(out) :: tsurf(ngrid) ! surface temperature
-      real,intent(out) :: tsoil(ngrid,nsoil) ! soil temperature
-      real,intent(out) :: emis(ngrid) ! surface emissivity
-      real,intent(out) :: q2(ngrid,nlay+1) ! 
-      real,intent(out) :: qsurf(ngrid,nq) ! tracers on surface
-      real,intent(out) :: co2ice(ngrid) ! co2 ice cover
-
-!======================================================================
-!  Local variables:
-
-      real surffield(ngrid) ! to temporarily store a surface field
-      real xmin,xmax ! to display min and max of a field
-c
-      INTEGER ig,iq,lmax
-      INTEGER nid, nvarid
-      INTEGER ierr, i, nsrf
-!      integer isoil 
-!      INTEGER length
-!      PARAMETER (length=100)
-      CHARACTER*7 str7
-      CHARACTER*2 str2
-      CHARACTER*1 yes
-c
-      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
-      INTEGER nqold
-
-! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
-      logical :: oldtracernames=.false.
-      integer :: count
-      character(len=30) :: txt ! to store some text
-
-! specific for time 
-      REAL,ALLOCATABLE :: time(:) ! times stored in start
-      INTEGER timelen ! number of times stored in the file
-      INTEGER indextime ! index of selected time
-
-      INTEGER edges(3),corner(3)
-
-
-c
-c Ouvrir le fichier contenant l etat initial:
-c
-
-      ierr=nf90_open(fichnom,NF90_NOWRITE,nid)
-      IF (ierr.NE.nf90_noerr) THEN
-        write(6,*)' Pb d''ouverture du fichier ',trim(fichnom)
-        write(*,*)trim(nf90_strerror(ierr))
-        CALL ABORT
-      ENDIF
-
-! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
-!                    qsurf02, ...)
-      count=0
-      do iq=1,nqtot
-        txt= " "
-        write(txt,'(a5,i2.2)')'qsurf',iq
-        ierr=nf90_inq_varid(nid,txt,nvarid)
-        if (ierr.ne.nf90_noerr) then
-          ! did not find old tracer name
-          exit ! might as well stop here
-        else
-          ! found old tracer name
-          count=count+1
-        endif
-      enddo
-      if (count.eq.nqtot) then
-        write(*,*) "phyetat0:tracers seem to follow old naming ",
-     &             "convention (qsurf01,qsurf02,...)"
-        write(*,*) "   => will work for now ... "
-        write(*,*) "      but you should run newstart to rename them"
-        oldtracernames=.true.
-      endif
-
-c modifications possibles des variables de tab_cntrl
-      PRINT*
-      write(*,*) 'TABFI de phyeta0',Lmodif,tab0
-      call tabfi (nid,Lmodif,tab0,day_ini,lmax,p_rad,
-     .              p_omeg,p_g,p_mugaz,p_daysec,time0)
-c
-c Read latitudes (coordinates): No need, these are provided by the dynamics
-c
-!      ierr=nf90_inq_varid(nid,"latitude",nvarid)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Le champ <latitude> est absent'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-!      ierr=nf90_get_var(nid,nvarid,lati)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-c
-c read longitudes (coordinates): No need, these are provided by the dynamics
-c
-!      ierr=nf90_inq_varid(nid,"longitude",nvarid)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Le champ <longitude> est absent'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-!      ierr=nf90_get_var(nid,nvarid,long)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Lecture echouee pour <longitude>'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-c
-c Read areas of meshes: No need, these are provided by the dynamics
-c
-!      ierr=nf90_inq_varid(nid,"area",nvarid)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Le champ <area> est absent'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-!      ierr=nf90_get_var(nid,nvarid,area)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Lecture echouee pour <area>'
-!         write(*,*)trim(nf90_strerror(ierr))
-!         CALL abort
-!      ENDIF
-!      xmin = 1.0E+20
-!      xmax = -1.0E+20
-!      xmin = MINVAL(area)
-!      xmax = MAXVAL(area)
-!      PRINT*,'Aires des mailles <area>:', xmin, xmax
-c
-c Lecture du geopotentiel au sol:
-c
-      ierr=nf90_inq_varid(nid,"phisfi",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <phisfi> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,phisfi)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <phisfi>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(phisfi)
-      xmax = MAXVAL(phisfi)
-      PRINT*,'Geopotentiel au sol <phisfi>:', xmin, xmax
-c
-c Lecture de l''albedo du sol nu:
-c
-      ierr=nf90_inq_varid(nid,"albedodat",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <albedodat> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,albedodat)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <albedodat>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(albedodat)
-      xmax = MAXVAL(albedodat)
-      PRINT*,'Albedo du sol nu <albedodat>:', xmin, xmax
-c
-c Lecture de l''inertie thermique du sol:
-c
-!      ierr = NF_INQ_VARID (nid, "inertiedat", nvarid)
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Le champ <inertiedat> est absent'
-!         CALL abort
-!      ENDIF
-!#ifdef NC_DOUBLE
-!      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, inertiedat)
-!#else
-!      ierr = NF_GET_VAR_REAL(nid, nvarid, inertiedat)
-!#endif
-!      IF (ierr.NE.nf90_noerr) THEN
-!         PRINT*, 'phyetat0: Lecture echouee pour <inertiedat>'
-!         CALL abort
-!      ENDIF
-!      xmin = 1.0E+20
-!      xmax = -1.0E+20
-!      xmin = MINVAL(inertiedat)
-!      xmax = MAXVAL(inertiedat)
-!      PRINT*,'Inertie thermique du sol <inertiedat>:', xmin, xmax
-c
-c ZMEA
-c
-      ierr=nf90_inq_varid(nid,"ZMEA",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,zmea)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = MINVAL(zmea)
-      xmax = MAXVAL(zmea)
-      PRINT*,'<zmea>:', xmin, xmax
-c
-c ZSTD
-c
-      ierr=nf90_inq_varid(nid,"ZSTD",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,zstd)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = MINVAL(zstd)
-      xmax = MAXVAL(zstd)
-      PRINT*,'<zstd>:', xmin, xmax
-c
-c ZSIG
-c
-      ierr=nf90_inq_varid(nid,"ZSIG",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,zsig)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = MINVAL(zsig)
-      xmax = MAXVAL(zsig)
-      PRINT*,'<zsig>:', xmin, xmax
-c
-c ZGAM
-c
-      ierr=nf90_inq_varid(nid,"ZGAM",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,zgam)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = MINVAL(zgam)
-      xmax = MAXVAL(zgam)
-      PRINT*,'<zgam>:', xmin, xmax
-c
-c ZTHE
-c
-      ierr=nf90_inq_varid(nid,"ZTHE",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,zthe)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = MINVAL(zthe)
-      xmax = MAXVAL(zthe)
-      PRINT*,'<zthe>:', xmin, xmax
-      
-c
-c Time axis
-c
-      ierr = nf90_inq_dimid(nid,"Time",nvarid)
-
-      IF (ierr .NE. nf90_noerr) THEN
-        indextime = 1
-        print*, "phyetat0: No time axis found in "//fichnom
-      
-      ELSE
-        print*, "phyetat0: Time axis found in "//fichnom
-       
-        ierr = nf90_inquire_dimension(nid,nvarid,len=timelen)
-        
-        ALLOCATE(time(timelen))
-  
-        ierr=nf90_inq_varid(nid,"Time",nvarid)
-        IF (ierr .NE. nf90_noerr) THEN
-  	     ierr=nf90_inq_varid(nid,"temps", nvarid)
-  		 IF (ierr .NE. nf90_noerr) THEN
-             PRINT*, "dynetat0: <Time> or <temps> absent"
-             write(*,*)trim(nf90_strerror(ierr))
-             CALL abort
-           ENDIF
-        ENDIF
-        ierr=nf90_get_var(nid,nvarid,time)
-        IF (ierr .NE. nf90_noerr) THEN
-           PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
-           write(*,*)trim(nf90_strerror(ierr))
-           CALL abort
-        ENDIF
-c      
-c Select desired time
-c
-        IF (timestart .lt. 0) THEN  ! default: we use the last time value
-          indextime = timelen
-        ELSE  ! else we look for the desired value in the time axis
-         indextime = 0
-          DO i=1,timelen
-            IF (abs(time(i) - timestart) .lt. 0.01) THEN
-               indextime = i
-               EXIT
-            ENDIF
-          ENDDO
-          IF (indextime .eq. 0) THEN
-            PRINT*, "Time", timestart," is not in "//fichnom//"!!"
-            PRINT*, "Stored times are:"
-            DO i=1,timelen
-               PRINT*, time(i)
-            ENDDO
-            CALL abort
-          ENDIF
-        ENDIF
-        
-        ! In startfi the absolute date is day_ini + time0 + time
-        ! For now on, in the GCM physics, it is day_ini + time0
-        time0 = time(indextime) + time0
-        day_ini = day_ini + INT(time0)
-        time0 = time0 - INT(time0)
-        
-        PRINT*, "phyetat0: Selected time ",time(indextime),
-     .          " at index ",indextime
-     
-        DEALLOCATE(time)
-        
-      ENDIF ! of IF (Time not in file)
-      
-      
-c
-c CO2 ice cover
-c
-      corner(1)=1
-      corner(2)=indextime
-      edges(1)=ngrid
-      edges(2)=1
-      ierr=nf90_inq_varid(nid,"co2ice",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <co2ice> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,co2ice,corner,edges)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <co2ice>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(co2ice)
-      xmax = MAXVAL(co2ice)
-      PRINT*,'CO2 ice cover <co2ice>:', xmin, xmax
-c
-c Lecture des temperatures du sol:
-c
-      ierr=nf90_inq_varid(nid,"tsurf",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <tsurf> est absent'
-! Ehouarn: dump this part (causes problems with netcdf90 interface)
-!         PRINT*, '          Mais je vais essayer de lire TS**'
-!         IF (nbsrf.GT.99) THEN
-!            PRINT*, "Trop de sous-mailles"
-!            CALL abort
-!         ENDIF
-!         DO nsrf = 1, nbsrf
-!           WRITE(str2,'(i2.2)') nsrf
-!           ierr=nf90_inq_varid(nid,"TS"//str2,nvarid)
-!           IF (ierr.NE.nf90_noerr) THEN
-!              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
-!              write(*,*)trim(nf90_strerror(ierr))
-!              CALL abort
-!           ENDIF
-!           ierr=nf90_get_var(nid,nvarid,tsurf(1,nsrf))
-!           IF (ierr.NE.nf90_noerr) THEN
-!             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
-!             write(*,*)trim(nf90_strerror(ierr))
-!             CALL abort
-!           ENDIF
-!           xmin = 1.0E+20
-!           xmax = -1.0E+20
-!           xmin = MINVAL(tsurf)
-!           xmax = MAXVAL(tsurf)
-!           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
-!         ENDDO
-      ELSE
-         PRINT*, 'phyetat0: Le champ <tsurf> est present'
-         PRINT*, '          J ignore donc les autres temperatures TS**'
-         !ierr=nf90_get_var(nid,nvarid,tsurf(1,1))
-         ierr=nf90_get_var(nid,nvarid,tsurf,corner,edges)
-         IF (ierr.NE.nf90_noerr) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <TSURF>"
-            write(*,*)trim(nf90_strerror(ierr))
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         xmin = MINVAL(tsurf)
-         xmax = MAXVAL(tsurf)
-         PRINT*,'Temperature du sol <tsurf>', xmin, xmax
-! Ehouarn: Mars => nbsurf=1
-!         IF (nbsrf >= 2) THEN
-!            DO nsrf = 2, nbsrf
-!               DO i = 1, ngrid
-!                  tsurf(i,nsrf) = tsurf(i,1)
-!               ENDDO
-!            ENDDO
-!         ENDIF
-      ENDIF
-c
-c Lecture des temperatures du sol profond:
-c
-!      IF (nsoil.GT.99 .OR. nbsrf.GT.99) THEN
-!         PRINT*, "Trop de couches ou sous-mailles"
-!         CALL abort
-!      ENDIF
-!      DO nsrf = 1, nbsrf
-!         DO isoil=1, nsoil
-!            WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
-!            ierr = NF_INQ_VARID (nid, 'tsoil', nvarid)
-!            IF (ierr.NE.nf90_noerr) THEN
-!               PRINT*, "phyetat0: Le champ <tsoil> est absent"
-!               PRINT*, "          Il prend donc la valeur de surface"
-!               DO i=1, ngrid
-!                  tsoil(i,isoil,nsrf)=tsurf(i,nsrf)
-!               ENDDO
-!            ELSE
-!#ifdef NC_DOUBLE
-!              ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,1,nsrf))
-!#else
-!              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,1,nsrf))
-!#endif
-!               IF (ierr.NE.nf90_noerr) THEN
-!                  PRINT*, "Lecture echouee pour <tsoil>"
-!                  CALL abort
-!               ENDIF
-!            ENDIF
-!         ENDDO
-!      ENDDO
-!      xmin = 1.0E+20
-!      xmax = -1.0E+20
-!      xmin = MINVAL(tsoil)
-!      xmax = MAXVAL(tsoil)
-!      PRINT*,'Temperatures du sol profond <tsoil>', xmin, xmax
-c
-c Surface emissivity
-c
-      ierr=nf90_inq_varid(nid,"emis",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <emis> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,emis,corner,edges)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <emis>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(emis)
-      xmax = MAXVAL(emis)
-      PRINT*,'Surface emissivity <emis>:', xmin, xmax
-
-!
-! surface roughness length (NB: z0 is a common in surfdat_h)
-!
-      ierr=nf90_inq_varid(nid,"z0",nvarid)
-      if (ierr.ne.nf90_noerr) then
-        write(*,*) 'phyetat0: did not find z0 field!'
-        write(*,*) 'will use constant value of z0_default instead'
-        z0(:)=z0_default
-      else
-        ierr=nf90_get_var(nid,nvarid,z0)
-        if (ierr.ne.nf90_noerr) then
-          write(*,*) 'phyetat0: Failed loading <z0>'
-          write(*,*)trim(nf90_strerror(ierr))
-          call abort
-        endif
-        xmin=1.0E+20
-        xmax=-1.0E+20
-        xmin=minval(z0)
-        xmax=maxval(z0)
-        write(*,*)'Surface roughness <z0>:',xmin,xmax
-      endif
-
-
-c
-c pbl wind variance
-c
-      corner(1)=1
-      corner(2)=1
-      corner(3)=indextime
-      edges(1)=ngrid
-      edges(2)=nlay+1
-      edges(3)=1
-      ierr=nf90_inq_varid(nid,"q2",nvarid)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Le champ <q2> est absent'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      ierr=nf90_get_var(nid,nvarid,q2,corner,edges)
-      IF (ierr.NE.nf90_noerr) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <q2>'
-         write(*,*)trim(nf90_strerror(ierr))
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(q2)
-      xmax = MAXVAL(q2)
-      PRINT*,'pbl wind variance <q2>:', xmin, xmax
-c
-c tracer on surface
-c
-      corner(1)=1
-      corner(2)=indextime
-      edges(1)=ngrid
-      edges(2)=1
-      IF(nq.GE.1) THEN
-         nqold=nq
-         DO iq=1,nq
-!            str7(1:5)='qsurf'
-!            WRITE(str7(6:7),'(i2.2)') iq
-!            ierr = NF_INQ_VARID (nid,str7,nvarid)
-           IF (oldtracernames) THEN
-             txt=" "
-             write(txt,'(a5,i2.2)')'qsurf',iq
-           ELSE
-             txt=tnom(iq)
-             if (txt.eq."h2o_vap") then
-               ! There is no surface tracer for h2o_vap;
-               ! "h2o_ice" should be loaded instead
-               txt="h2o_ice"
-               write(*,*) 'phyetat0: loading surface tracer',
-     &                     ' h2o_ice instead of h2o_vap'
-             endif
-           ENDIF ! of IF (oldtracernames) THEN
-           ierr=nf90_inq_varid(nid,txt,nvarid)
-           IF (ierr.NE.nf90_noerr) THEN
-             write(*,*) 'PHYETAT0: WARNING : surface tracer',trim(txt),
-     &                  ' not found in file'
-             write(*,*) trim(txt), ' set to 0'
-             do ig=1,ngrid
-               qsurf(ig,iq)=0.
-             end do
-             nqold=min(iq-1,nqold)
-           ELSE
-           !ierr=nf90_get_var(nid,nvarid,qsurf(1,iq))
-           ierr=nf90_get_var(nid,nvarid,surffield,corner,edges)
-           qsurf(1:ngrid,iq)=surffield(1:ngrid)
-             IF (ierr.NE.nf90_noerr) THEN
-               PRINT*, 'phyetat0: Lecture echouee pour <',trim(txt),'>'
-               write(*,*)trim(nf90_strerror(ierr))
-               CALL abort
-             ENDIF
-           ENDIF
-           xmin = 1.0E+20
-           xmax = -1.0E+20
-           xmin = MINVAL(qsurf(1:ngrid,iq))
-           xmax = MAXVAL(qsurf(1:ngrid,iq))
-           PRINT*,'tracer on surface <',trim(txt),'>:',xmin,xmax
-         ENDDO
-         if ((nqold.lt.nq).and.(nqold.ge.1)) then
-c        case when new tracer are added in addition to old ones
-             write(*,*)'qsurf 1 to ', nqold,'were already present'
-             write(*,*)'qsurf ', nqold+1,' to ', nqtot,'are new'
-!            yes=' '
-!            do while ((yes.ne.'y').and.(yes.ne.'n'))
-!             write(*,*) 'Would you like to reindex qsurf # 1 ->',nqold
-!             write(*,*) 'to #',nqtot-nqold+1,'->', nqtot,'   (y or n) ?'
-!             read(*,fmt='(a)') yes
-!            end do
-!            if (yes.eq.'y') then
-!              write(*,*) 'OK, let s reindex qsurf'
-!                 do ig=1,ngrid
-!                    do iq=nqtot,nqtot-nqold+1,-1
-!                       qsurf(ig,iq)=qsurf(ig,iq-nqtot+nqold)
-!                    end do
-!                    do iq=nqtot-nqold,1,-1
-!                       qsurf(ig,iq)= 0.
-!                    end do
-!                 end do
-!            end if
-         end if
-      ENDIF
-
-! Call to soil_settings, in order to read soil temperatures,
-! as well as thermal inertia and volumetric heat capacity
-
-      call soil_settings(nid,ngrid,nsoil,tsurf,tsoil,indextime)
-c
-c Fermer le fichier:
-c
-      ierr=nf90_close(nid)
-c
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/phymars/phyetat0.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/phyetat0.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/phyetat0.F90	(revision 1130)
@@ -0,0 +1,314 @@
+subroutine phyetat0 (fichnom,tab0,Lmodif,nsoil,ngrid,nlay,nq, &
+                     day_ini,time0,tsurf,tsoil,emis,q2,qsurf,co2ice)
+
+!  use netcdf
+  use infotrac, only: nqtot, tname
+  use surfdat_h, only: phisfi, albedodat, z0, z0_default,&
+                       zmea, zstd, zsig, zgam, zthe
+  use control_mod, only: timestart
+  use iostart, only: nid_start, open_startphy, close_startphy, &
+                     get_field, get_var, inquire_field, &
+                     inquire_dimension, inquire_dimension_length
+  implicit none
+!======================================================================
+! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+!  Adaptation à Mars : Yann Wanherdrick 
+! Objet: Lecture de l etat initial pour la physique
+! Modifs: Aug.2010 EM : use NetCDF90 to load variables (enables using
+!                      r4 or r8 restarts independently of having compiled
+!                      the GCM in r4 or r8)
+!         June 2013 TN : Possibility to read files with a time axis
+!         November 2013 EM : Enabeling parallel, using iostart module
+!======================================================================
+!#include "netcdf.inc"
+!#include "dimensions.h"
+!#include "dimphys.h"
+!#include "comgeomfi.h"
+!#include "surfdat.h"
+#include "planete.h"
+!#include "dimradmars.h"
+!#include "yomaer.h"
+#include "comcstfi.h"
+!#include "tracer.h"
+!#include "advtrac.h"
+!#include "control.h"
+!======================================================================
+  INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+  PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+!======================================================================
+!  Arguments:
+!  ---------
+!  inputs:
+  character*(*),intent(in) :: fichnom ! "startfi.nc" file
+  integer,intent(in) :: tab0
+  integer,intent(in) :: Lmodif
+  integer,intent(in) :: nsoil ! # of soil layers
+  integer,intent(in) :: ngrid ! # of atmospheric columns
+  integer,intent(in) :: nlay ! # of atmospheric layers
+  integer,intent(in) :: nq
+  integer :: day_ini
+  real :: time0
+
+!  outputs:
+  real,intent(out) :: tsurf(ngrid) ! surface temperature
+  real,intent(out) :: tsoil(ngrid,nsoil) ! soil temperature
+  real,intent(out) :: emis(ngrid) ! surface emissivity
+  real,intent(out) :: q2(ngrid,nlay+1) ! 
+  real,intent(out) :: qsurf(ngrid,nq) ! tracers on surface
+  real,intent(out) :: co2ice(ngrid) ! co2 ice cover
+
+!======================================================================
+!  Local variables:
+
+      real surffield(ngrid) ! to temporarily store a surface field
+      real xmin,xmax ! to display min and max of a field
+!
+      INTEGER ig,iq,lmax
+      INTEGER nid, nvarid
+      INTEGER ierr, i, nsrf
+!      integer isoil 
+!      INTEGER length
+!      PARAMETER (length=100)
+      CHARACTER*7 str7
+      CHARACTER*2 str2
+      CHARACTER*1 yes
+!
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+      INTEGER nqold
+
+! flag which identifies if 'startfi.nc' file is using old names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: count
+      character(len=30) :: txt ! to store some text
+
+! specific for time 
+      REAL,ALLOCATABLE :: time(:) ! times stored in start
+      INTEGER timelen ! number of times stored in the file
+      INTEGER indextime ! index of selected time
+
+      INTEGER :: edges(3),corner(3)
+      LOGICAL :: found
+
+! open physics initial state file:
+call open_startphy(fichnom)
+
+
+! possibility to modify tab_cntrl in tabfi
+write(*,*)
+write(*,*) 'TABFI in phyeta0: Lmodif=',Lmodif," tab0=",tab0
+call tabfi (nid_start,Lmodif,tab0,day_ini,lmax,p_rad, &
+            p_omeg,p_g,p_mugaz,p_daysec,time0)
+
+
+! Load surface geopotential:
+call get_field("phisfi",phisfi,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <phisfi>"
+  call abort
+else
+  write(*,*) "phyetat0: surface geopotential <phisfi> range:", &
+             minval(phisfi), maxval(phisfi)
+endif
+
+
+! Load bare ground albedo:
+call get_field("albedodat",albedodat,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <albedodat>"
+  call abort
+else
+  write(*,*) "phyetat0: Bare ground albedo <albedodat> range:", &
+             minval(albedodat), maxval(albedodat)
+endif
+
+! ZMEA
+call get_field("ZMEA",zmea,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZMEA>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZMEA> range:", &
+             minval(zmea), maxval(zmea)
+endif
+
+
+! ZSTD
+call get_field("ZSTD",zstd,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZSTD>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZSTD> range:", &
+             minval(zstd), maxval(zstd)
+endif
+
+
+! ZSIG
+call get_field("ZSIG",zsig,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZSIG>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZSIG> range:", &
+             minval(zsig), maxval(zsig)
+endif
+
+
+! ZGAM
+call get_field("ZGAM",zgam,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZGAM>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZGAM> range:", &
+             minval(zgam), maxval(zgam)
+endif
+
+
+! ZTHE
+call get_field("ZTHE",zthe,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <ZTHE>"
+  call abort
+else
+  write(*,*) "phyetat0: <ZTHE> range:", &
+             minval(zthe), maxval(zthe)
+endif
+
+      
+! Time axis
+found=inquire_dimension("Time")
+if (.not.found) then
+  indextime = 1
+  write(*,*) "phyetat0: No time axis found in "//trim(fichnom)
+else
+  write(*,*) "phyetat0: Time axis found in "//trim(fichnom)
+  timelen=inquire_dimension_length("Time")
+  allocate(time(timelen))
+  ! load "Time" array:
+  call get_var("Time",time,found)
+  if (.not.found) then
+    write(*,*) "phyetat0: Failed loading <Time>"
+    call abort
+  endif
+  ! seclect the desired time index
+  IF (timestart .lt. 0) THEN  ! default: we use the last time value
+    indextime = timelen
+  ELSE  ! else we look for the desired value in the time axis
+    indextime = 0
+    DO i=1,timelen
+      IF (abs(time(i) - timestart) .lt. 0.01) THEN
+        indextime = i
+        EXIT
+      ENDIF
+    ENDDO
+    IF (indextime .eq. 0) THEN
+      PRINT*, "Time", timestart," is not in "//trim(fichnom)//"!!"
+      PRINT*, "Stored times are:"
+      DO i=1,timelen
+         PRINT*, time(i)
+      ENDDO
+      CALL abort
+    ENDIF
+  ENDIF ! of IF (timestart .lt. 0)
+  ! In startfi the absolute date is day_ini + time0 + time
+  ! For now on, in the GCM physics, it is day_ini + time0
+  time0 = time(indextime) + time0
+  day_ini = day_ini + INT(time0)
+  time0 = time0 - INT(time0)
+        
+  PRINT*, "phyetat0: Selected time ",time(indextime), &
+          " at index ",indextime
+     
+  DEALLOCATE(time)
+endif ! of if Time not found in file
+
+
+! CO2 ice cover
+call get_field("co2ice",co2ice,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <co2ice>"
+  call abort
+else
+  write(*,*) "phyetat0: CO2 ice cover <co2ice> range:", &
+             minval(co2ice), maxval(co2ice)
+endif
+
+
+! Surface temperature :
+call get_field("tsurf",tsurf,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <tsurf>"
+  call abort
+else
+  write(*,*) "phyetat0: Surface temperature <tsurf> range:", &
+             minval(tsurf), maxval(tsurf)
+endif
+
+! Surface emissivity
+call get_field("emis",emis,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <emis>"
+  call abort
+else
+  write(*,*) "phyetat0: Surface emissivity <emis> range:", &
+             minval(emis), maxval(emis)
+endif
+
+
+! surface roughness length (NB: z0 is a common in surfdat_h)
+call get_field("z0",z0,found)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <z0>"
+  write(*,*) 'will use constant value of z0_default:',z0_default
+  z0(:)=z0_default
+else
+  write(*,*) "phyetat0: Surface roughness <z0> range:", &
+             minval(z0), maxval(z0)
+endif
+
+
+! pbl wind variance
+call get_field("q2",q2,found,indextime)
+if (.not.found) then
+  write(*,*) "phyetat0: Failed loading <q2>"
+  call abort
+else
+  write(*,*) "phyetat0: PBL wind variance <q2> range:", &
+             minval(q2), maxval(q2)
+endif
+
+
+! tracer on surface
+if (nq.ge.1) then
+  do iq=1,nq
+    txt=tname(iq)
+    if (txt.eq."h2o_vap") then
+      ! There is no surface tracer for h2o_vap;
+      ! "h2o_ice" should be loaded instead
+      txt="h2o_ice"
+      write(*,*) 'phyetat0: loading surface tracer', &
+                           ' h2o_ice instead of h2o_vap'
+    endif
+    call get_field(txt,qsurf(:,iq),found,indextime)
+    if (.not.found) then
+      write(*,*) "phyetat0: Failed loading <",trim(txt),">"
+      write(*,*) "         ",trim(txt)," is set to zero"
+    else
+      write(*,*) "phyetat0: Surface tracer <",trim(txt),"> range:", &
+                 minval(qsurf(:,iq)), maxval(qsurf(:,iq))
+    endif
+  enddo
+endif ! of if (nq.ge.1)
+
+! Call to soil_settings, in order to read soil temperatures,
+! as well as thermal inertia and volumetric heat capacity
+
+      call soil_settings(nid_start,ngrid,nsoil,tsurf,tsoil,indextime)
+
+!
+! close file:
+!
+      call close_startphy
+
+      END
Index: trunk/LMDZ.MARS/libf/phymars/phyredem.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/phyredem.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/phyredem.F90	(revision 1130)
@@ -0,0 +1,231 @@
+!
+! $Id: $
+!
+module phyredem
+
+implicit none
+
+contains
+
+subroutine physdem0(filename,lonfi,latfi,nsoil,ngrid,nlay,nq, &
+                         phystep,day_ini,time,airefi, &
+                         alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
+! create physics restart file and write time-independent variables
+  use infotrac, only: nqtot, tname
+  use comsoil_h, only: inertiedat, volcapa, mlayer
+  use comgeomfi_h, only: area
+  use surfdat_h, only: albedodat, zmea, zstd, zsig, zgam, zthe, &
+                       z0_default, albedice, emisice, emissiv, &
+                       iceradius, dtemisice, phisfi, z0
+  use yomaer_h, only: tauvis
+  use iostart, only : open_restartphy, close_restartphy, & 
+                      put_var, put_field, length
+  use mod_grid_phy_lmdz, only : klon_glo
+
+  implicit none
+#include "planete.h"
+#include "comcstfi.h"
+ 
+  character(len=*), intent(in) :: filename
+  real,intent(in) :: lonfi(ngrid)
+  real,intent(in) :: latfi(ngrid)
+  integer,intent(in) :: nsoil
+  integer,intent(in) :: ngrid
+  integer,intent(in) :: nlay
+  integer,intent(in) :: nq
+  real,intent(in) :: phystep
+  real,intent(in) :: day_ini
+  real,intent(in) :: time
+  real,intent(in) :: airefi(ngrid)
+  real,intent(in) :: alb(ngrid)
+  real,intent(in) :: ith(ngrid,nsoil)
+  real,intent(in) :: pzmea(ngrid)
+  real,intent(in) :: pzstd(ngrid)
+  real,intent(in) :: pzsig(ngrid)
+  real,intent(in) :: pzgam(ngrid)
+  real,intent(in) :: pzthe(ngrid)
+ 
+  real :: tab_cntrl(length) ! nb "length=100" defined in iostart module
+  
+  ! Create physics start file
+  call open_restartphy(filename)
+  
+  ! Build tab_cntrl(:) array
+  tab_cntrl(:)=0.0
+  !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+  ! Fill control array tab_cntrl(:) with parameters for this run
+  !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+  ! Informations on the physics grid
+  tab_cntrl(1) = float(klon_glo)  ! total number of nodes on physics grid
+  tab_cntrl(2) = float(nlay) ! number of atmospheric layers
+  tab_cntrl(3) = day_ini + int(time)      ! initial day 
+  tab_cntrl(4) = time -int(time)          ! initial time of day
+
+  ! Informations about Mars, used by dynamics and physics
+  tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
+  tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
+  tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
+  tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
+  tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
+  tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
+
+  tab_cntrl(11) = phystep  ! time step in the physics
+  tab_cntrl(12) = 0.
+  tab_cntrl(13) = 0.
+
+  ! Informations about Mars, only for physics
+  tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
+  tab_cntrl(15) = periheli  ! min. Sun-Mars distance (Mkm) ~206.66
+  tab_cntrl(16) = aphelie   ! max. SUn-Mars distance (Mkm) ~249.22
+  tab_cntrl(17) = peri_day  ! date of perihelion (sols since N. spring)
+  tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
+
+  ! Boundary layer and turbulence
+  tab_cntrl(19) = z0_default   ! default surface roughness (m) ~0.01
+  tab_cntrl(20) = lmixmin   ! mixing length ~100
+  tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
+
+  ! Optical properties of polar caps and ground emissivity
+  tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
+  tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
+  tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
+  tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
+  tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
+  tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
+  tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
+  tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
+  tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
+
+  ! dust aerosol properties
+  tab_cntrl(27) = tauvis      ! mean visible optical depth
+
+  ! Soil properties:
+  tab_cntrl(35) = volcapa ! soil volumetric heat capacity
+
+  ! Write the controle array
+  call put_var("controle","Control parameters",tab_cntrl)
+  
+  ! Write the mid-layer depths
+  call put_var("soildepth","Soil mid-layer depth",mlayer)
+  
+  ! Write longitudes
+  call put_field("longitude","Longitudes of physics grid",lonfi)
+  
+  ! Write latitudes
+  call put_field("latitude","Latitudes of physics grid",latfi)
+  
+  ! Write mesh areas
+  call put_field("area","Mesh area",area)
+  
+  ! Write surface geopotential
+  call put_field("phisfi","Geopotential at the surface",phisfi)
+  
+  ! Write surface albedo
+  call put_field("albedodat","Albedo of bare ground",albedodat)
+  
+  ! Subgrid topogaphy variables
+  call put_field("ZMEA","Relief: mean relief",zmea)
+  call put_field("ZSTD","Relief: standard deviation",zstd)
+  call put_field("ZSIG","Relief: sigma parameter",zsig)
+  call put_field("ZGAM","Relief: gamma parameter",zgam)
+  call put_field("ZTHE","Relief: theta parameter",zthe)
+  
+  ! Soil thermal inertia
+  call put_field("inertiedat","Soil thermal inertia",inertiedat)
+  
+  ! Surface roughness length
+  call put_field("z0","Surface roughness length",z0)
+  
+  ! Close file
+  call close_restartphy
+  
+end subroutine physdem0
+
+subroutine physdem1(filename,nsoil,ngrid,nlay,nq, &
+                    phystep,time,tsurf,tsoil,co2ice,emis,q2,qsurf)
+  ! write time-dependent variable to restart file
+  use iostart, only : open_restartphy, close_restartphy, & 
+                      put_var, put_field
+  use infotrac, only: nqtot, tname
+  implicit none
+  character(len=*),intent(in) :: filename
+  integer,intent(in) :: nsoil
+  integer,intent(in) :: ngrid
+  integer,intent(in) :: nlay
+  integer,intent(in) :: nq
+  real,intent(in) :: phystep
+  real,intent(in) :: time
+  real,intent(in) :: tsurf(ngrid)
+  real,intent(in) :: tsoil(ngrid,nsoil)
+  real,intent(in) :: co2ice(ngrid)
+  real,intent(in) :: emis(ngrid)
+  real,intent(in) :: q2(ngrid,nlay+1)
+  real,intent(in) :: qsurf(ngrid,nq)
+  
+  integer :: iq
+  character(len=30) :: txt ! to store some text
+  ! indexes of water vapour & water ice tracers (if any):
+  integer :: i_h2o_vap=0
+  integer :: i_h2o_ice=0
+
+  
+  ! Open file
+  call open_restartphy(filename)
+  
+  ! First variable to write must be "Time", in order to correctly
+  ! set time counter in file
+  call put_var("Time","Temps de simulation",time)
+  
+  ! CO2 ice layer
+  call put_field("co2ice","CO2 ice cover",co2ice,time)
+  
+  ! Surface temperature
+  call put_field("tsurf","Surface temperature",tsurf,time)
+  
+  ! Soil temperature
+  call put_field("tsoil","Soil temperature",tsoil,time)
+  
+  ! Emissivity of the surface
+  call put_field("emis","Surface emissivity",emis,time)
+  
+  ! Planetary Boundary Layer
+  call put_field("q2","pbl wind variance",q2,time)
+  
+  ! Tracers on the surface
+  ! preliminary stuff: look for water vapour & water ice tracers (if any)
+  do iq=1,nq
+    if (tname(iq).eq."h2o_vap") then
+      i_h2o_vap=iq
+    endif
+    if (tname(iq).eq."h2o_ice") then
+      i_h2o_ice=iq
+    endif
+  enddo
+  
+  if (nq.gt.0) then
+    do iq=1,nq
+      txt=tname(iq)
+      ! Exception: there is no water vapour surface tracer
+      if (txt.eq."h2o_vap") then
+        write(*,*)"physdem1: skipping water vapour tracer"
+        if (i_h2o_ice.eq.i_h2o_vap) then
+          ! then there is no "water ice" tracer; but still
+          ! there is some water ice on the surface
+          write(*,*)"          writing water ice instead"
+          txt="h2o_ice"
+        else
+          ! there is a "water ice" tracer which has been / will be
+          ! delt with in due time
+          cycle
+        endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
+      endif ! of if (txt.eq."h2o_vap")
+      call put_field(trim(txt),"tracer on surface",qsurf(:,iq),time)
+    enddo
+  endif
+  
+  ! Close file
+  call close_restartphy
+  
+end subroutine physdem1
+
+end module phyredem
Index: trunk/LMDZ.MARS/libf/phymars/physdem.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/physdem.F	(revision 1127)
+++ 	(revision )
@@ -1,1031 +1,0 @@
-      subroutine physdem0(filename,lonfi,latfi,nsoil,ngrid,nlay,nq,
-     .                   phystep,day_ini,time,airefi,
-     .                   alb,ith,pzmea,pzstd,pzsig,pzgam,pzthe)
-
-      use infotrac, only: nqtot, tnom
-      use comsoil_h, only: inertiedat, volcapa, mlayer
-      use comgeomfi_h, only: area
-      use surfdat_h, only: albedodat, zmea, zstd, zsig, zgam, zthe,
-     &                     z0_default, albedice, emisice, emissiv,
-     &                     iceradius, dtemisice, phisfi, z0
-      use yomaer_h, only: tauvis
-      implicit none
-c
-c Variables qui NE possèdent PAS un axe des temps :
-c   airefi
-c   alb
-c   ith
-c   pzmea
-c   pzstd
-c   pzsig
-c   pzgam
-c   pzthe
-c
-c-------------------------------------------------------------
-c
-c create physics (re-)start data file "restartfi.nc"
-c
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-c-----------------------------------------------------------------------
-#include "comvert.h"
-#include "comgeom2.h"
-#include "control.h"
-#include "comdissnew.h"
-#include "logic.h"
-#include "ener.h"
-#include "netcdf.inc"
-!#include "dimphys.h"
-!#include "advtrac.h"
-#include "callkeys.h"
-c
-      INTEGER nid,iq
-      INTEGER, parameter :: ivap=1
-      REAL, parameter :: qsolmax= 150.0
-      character (len=*) :: filename
-      character (len=7) :: str7
-
-      REAL day_ini
-      INTEGER,INTENT(IN) :: nsoil,ngrid,nlay,nq
-      integer ierr,idim1,idim2,idim3,idim4,idim5,idim6,nvarid
-
-c
-      REAL phystep,time
-      REAL latfi(ngrid), lonfi(ngrid)
-!      REAL champhys(ngrid)
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length)
-
-c
-
-!      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
-!      EXTERNAL exner_hyb , SSUM
-c
-#include "serre.h"
-#include "clesph0.h"
-#include "fxyprim.h"
-!#include "comgeomfi.h"
-!#include "surfdat.h"
-!#include "comsoil.h"
-#include "planete.h"
-!#include "dimradmars.h"
-!#include "yomaer.h"
-#include "comcstfi.h"
-
-      real airefi(ngrid)
-      real alb(ngrid),ith(ngrid,nsoil)
-      real pzmea(ngrid),pzstd(ngrid)
-      real pzsig(ngrid),pzgam(ngrid),pzthe(ngrid)
-      integer ig
-
-! flag which identifies if we are using old tracer names (qsurf01,...)
-      logical :: oldtracernames=.false.
-      integer :: count
-      character(len=30) :: txt ! to store some text
-! indexes of water vapour & water ice tracers (if any):
-      integer :: i_h2o_vap=0
-      integer :: i_h2o_ice=0
-c-----------------------------------------------------------------------
-
-      ! copy airefi(:) to area(:)
-      CALL SCOPY(ngrid,airefi,1,area,1)
-      ! note: area() is defined in comgeomfi_h
-
-
-      DO ig=1,ngrid
-         albedodat(ig)=alb(ig) ! note: albedodat() is defined in surfdat_h
-         zmea(ig)=pzmea(ig) ! note: zmea() is defined in surfdat_h
-         zstd(ig)=pzstd(ig) ! note: zstd() is defined in surfdat_h
-         zsig(ig)=pzsig(ig) ! note: zsig() is defined in surfdat_h
-         zgam(ig)=pzgam(ig) ! note: zgam() is defined in surfdat_h
-         zthe(ig)=pzthe(ig) ! note: zthe() is defined in surfdat_h
-      ENDDO
-
-      inertiedat(:,:)=ith(:,:) ! note inertiedat() is defined in comsoil_h
-c
-c  things to store in the physics start file:
-c
-      ierr = NF_CREATE(adjustl(filename),  
-     &      IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        WRITE(6,*)'physdem0: Problem creating file ',adjustl(filename)
-        write(6,*) NF_STRERROR(ierr)
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 18,
-     .                       "Physics start file")
-c
-      ierr = NF_DEF_DIM (nid,"index",length,idim1)
-      if (ierr.ne.NF_NOERR) then
-        WRITE(6,*)'physdem0: Problem defining index dimension'
-	write(6,*) NF_STRERROR(ierr)
-        call abort
-      endif
-c
-      ierr = NF_DEF_DIM (nid,"physical_points",ngrid,idim2)
-      if (ierr.ne.NF_NOERR) then
-        WRITE(6,*)'physdem0: Problem defining physical_points dimension'
-	write(6,*) NF_STRERROR(ierr)
-        call abort
-      endif
-c
-      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoil,idim3)
-      if (ierr.ne.NF_NOERR) then
-      WRITE(6,*)'physdem0: Problem defining subsurface_layers dimension'
-	write(6,*) NF_STRERROR(ierr)
-        call abort
-      endif
-c
-!      ierr = NF_DEF_DIM (nid,"nlayer+1",llm+1,idim4)
-      ierr = NF_DEF_DIM (nid,"nlayer_plus_1",llm+1,idim4)
-      if (ierr.ne.NF_NOERR) then
-        WRITE(6,*)'physdem0: Problem defining nlayer+1 dimension'
-        write(6,*) NF_STRERROR(ierr)
-	call abort
-      endif
-c
-      ierr = NF_DEF_DIM (nid,"number_of_advected_fields",nq,idim5)
-      if (ierr.ne.NF_NOERR) then
-        WRITE(6,*)'physdem0: Problem defining advected fields dimension'
-        WRITE(6,*)' nq = ',nq,' and ierr = ', ierr
-        write(6,*) NF_STRERROR(ierr)
-      endif
-c
-      ierr = NF_DEF_DIM (nid,"Time",NF_UNLIMITED,idim6)
-      if (ierr.ne.NF_NOERR) then
-        WRITE(6,*)'physdem0: Problem defining time dimension'
-        WRITE(6,*)' ierr = ', ierr
-        write(6,*) NF_STRERROR(ierr)
-      endif
-
-      ierr = NF_ENDDEF(nid) ! exit NetCDF define mode
-
-c clear tab_cntrl(:) array
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-
-      write(*,*) "physdem0: ngrid: ",ngrid
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c Fill control array tab_cntrl(:) with parameters for this run
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c Informations on the physics grid
-      tab_cntrl(1) = float(ngrid)  ! number of nodes on physics grid
-      tab_cntrl(2) = float(nlay) ! number of atmospheric layers
-      tab_cntrl(3) = day_ini + int(time)      ! initial day 
-      tab_cntrl(4) = time -int(time)          ! initial time of day
-
-c Informations about Mars, used by dynamics and physics
-      tab_cntrl(5) = rad      ! radius of Mars (m) ~3397200
-      tab_cntrl(6) = omeg     ! rotation rate (rad.s-1)
-      tab_cntrl(7) = g        ! gravity (m.s-2) ~3.72
-      tab_cntrl(8) = mugaz    ! Molar mass of the atmosphere (g.mol-1) ~43.49
-      tab_cntrl(9) = rcp      !  = r/cp  ~0.256793 (=kappa dans dynamique)
-      tab_cntrl(10) = daysec  ! length of a sol (s)  ~88775
-
-      tab_cntrl(11) = phystep  ! time step in the physics
-      tab_cntrl(12) = 0.
-      tab_cntrl(13) = 0.
-
-c Informations about Mars, only for physics
-      tab_cntrl(14) = year_day  ! length of year (sols) ~668.6
-      tab_cntrl(15) = periheli  ! min. Sun-Mars distance (Mkm) ~206.66
-      tab_cntrl(16) = aphelie   ! max. SUn-Mars distance (Mkm) ~249.22
-      tab_cntrl(17) = peri_day  ! date of perihelion (sols since N. spring)
-      tab_cntrl(18) = obliquit  ! Obliquity of the planet (deg) ~23.98
-
-c Boundary layer and turbulence
-      tab_cntrl(19) = z0_default   ! default surface roughness (m) ~0.01
-      tab_cntrl(20) = lmixmin   ! mixing length ~100
-      tab_cntrl(21) = emin_turb ! minimal energy ~1.e-8
-
-c Optical properties of polar caps and ground emissivity
-      tab_cntrl(22) = albedice(1)  ! Albedo of northern cap ~0.5
-      tab_cntrl(23) = albedice(2)  ! Albedo of southern cap ~0.5
-      tab_cntrl(24) = emisice(1)   ! Emissivity of northern cap ~0.95
-      tab_cntrl(25) = emisice(2)   ! Emissivity of southern cap ~0.95
-      tab_cntrl(26) = emissiv      ! Emissivity of martian soil ~.95
-      tab_cntrl(31) = iceradius(1) ! mean scat radius of CO2 snow (north)
-      tab_cntrl(32) = iceradius(2) ! mean scat radius of CO2 snow (south)
-      tab_cntrl(33) = dtemisice(1) ! time scale for snow metamorphism (north)
-      tab_cntrl(34) = dtemisice(2) ! time scale for snow metamorphism (south)
-
-c dust aerosol properties
-      tab_cntrl(27) = tauvis      ! mean visible optical depth
-
-      tab_cntrl(28) = 0. 
-      tab_cntrl(29) = 0.
-      tab_cntrl(30) = 0.
-
-! Soil properties:
-      tab_cntrl(35) = volcapa ! soil volumetric heat capacity
-      
-c
-      
-      ierr = NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'physdem0: Failed to swich to NetCDF define mode'
-         CALL abort
-      ENDIF
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'physdem0: Failed to define controle'
-         CALL abort
-      ENDIF
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
-     .                        "Control parameters")
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'physdem0: Failed to define controle title attribute'
-         CALL abort
-      ENDIF
-      ierr = NF_ENDDEF(nid) ! Leave NetCDF define mode
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'physdem0: Failed to swich out of NetCDF define mode'
-         CALL abort
-      ENDIF
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'physdem0: Failed to write controle data'
-         CALL abort
-      ENDIF
-      
-
-! write mid-layer depths 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,idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"soildepth",NF_FLOAT,1,idim3,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
-     .                        "Soil mid-layer depth")
-      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
-
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
-     .                        "Longitudes of physics grid")
-      ierr = NF_ENDDEF(nid)
-
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
-#endif
-
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
-     .                        "Latitudes of physics grid")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
-#endif
-
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "area", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "area", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                        "Mesh area")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
-#endif
-
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "phisfi", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "phisfi", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 27,
-     .                        "Geopotential at the surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phisfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,phisfi)
-#endif
-
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "albedodat", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "albedodat", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 21,
-     .                        "Albedo of bare ground")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedodat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedodat)
-#endif
-
-c
-c   some data for Francois Lott's programs
-c
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                        "Relief: mean relief")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                        "Relief: standard deviation")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                        "Relief: sigma parameter")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                        "Relief: gamma parameter")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                        "Relief: theta parameter")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
-#endif      
-          
- 
-! Soil Thermal inertia
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"inertiedat",NF_DOUBLE,
-     &                   2,(/idim2,idim3/),nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"inertiedat",NF_FLOAT,
-     &                   2,(/idim2,idim3/),nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 20,
-     .                        "Soil thermal inertia")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,inertiedat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,inertiedat)
-#endif
-
-! surface roughness length (z0 is a common in surfdat_h)
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "z0", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "z0", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 24,
-     .                        "Surface roughness length")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,z0)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,z0)
-#endif
-
-
-
-
-c--------------------- Time dependent variables ---------------------
-c-------------------------------------------------------------------
-c-------------------------------------------------------------------
-
-
-! Time
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1,
-     .                   (/idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1,
-     .                   (/idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                        "Temps de simulation")
-      ierr = NF_ENDDEF(nid)
-
-
-! CO2 Ice Cover
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "co2ice", NF_DOUBLE, 2,
-     .                   (/idim2,idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "co2ice", NF_FLOAT, 2,
-     .                   (/idim2,idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 13,
-     .                        "CO2 ice cover")
-      ierr = NF_ENDDEF(nid)
-
-
-!  Surface temperature
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "tsurf", NF_DOUBLE, 2,
-     .                   (/idim2,idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "tsurf", NF_FLOAT, 2,
-     .                   (/idim2,idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                        "Surface temperature")
-      ierr = NF_ENDDEF(nid)
-
-
-! Soil temperature
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "tsoil", NF_DOUBLE, 3, 
-     .                   (/idim2,idim3,idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "tsoil", NF_FLOAT, 3,
-     .                   (/idim2,idim3,idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 16,
-     .                        "Soil temperature")
-      ierr = NF_ENDDEF(nid)
-
-
-c emissivity
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"emis", NF_DOUBLE, 2,
-     .                   (/idim2,idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "emis", NF_FLOAT, 2,
-     .                   (/idim2,idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 18,
-     .                        "Surface emissivity")
-      ierr = NF_ENDDEF(nid)
-
-
-c planetary boundary layer
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "q2", NF_DOUBLE, 3,
-     .                   (/idim2,idim4,idim6/), nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "q2", NF_FLOAT, 3,
-     .                   (/idim2,idim4,idim6/), nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
-     .                        "pbl wind variance")
-      ierr = NF_ENDDEF(nid)
-
-
-
-
-c tracers
-!
-! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
-!                    qsurf02, ...)
-      count=0
-      do iq=1,nqtot
-        txt= " "
-        write(txt,'(a1,i2.2)')'q',iq
-        if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
-          ! did not find old tracer name
-          exit ! might as well stop here
-        else
-          ! found old tracer name
-          count=count+1
-        endif
-      enddo
-      if (count.eq.nqtot) then
-        write(*,*) "physdem0:tracers seem to follow old naming ",
-     &             "convention (qsurf01,qsurf02,...)"
-        write(*,*) "  => will work for now ... "
-        write(*,*) "     but you should run newstart to rename them"
-        oldtracernames=.true.
-      endif ! of if (count.eq.nqtot)
-
-      IF(nq.GE.1) THEN
-! preliminary stuff: look for water vapour & water ice tracers (if any)
-        if (.not.oldtracernames) then
-         do iq=1,nq
-           if (tnom(iq).eq."h2o_vap") then
-             i_h2o_vap=iq
-           endif
-           if (tnom(iq).eq."h2o_ice") then
-             i_h2o_ice=iq
-           endif
-         enddo ! of iq=1,nq
-         ! handle special case of only water vapour tracer (no ice)
-         if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
-          ! then the index of (surface) ice is i_h2o_vap
-          i_h2o_ice=i_h2o_vap
-         endif
-        endif ! of if (.not.oldtracernames) 
-
-         DO iq=1,nq
-           IF (oldtracernames) THEN
-             txt=" "
-             write(txt,'(a5,i2.2)')'qsurf',iq
-           ELSE
-             txt=tnom(iq)
-             ! Exception: there is no water vapour surface tracer
-             if (txt.eq."h2o_vap") then
-               write(*,*)"physdem0: skipping water vapour tracer"
-               if (i_h2o_ice.eq.i_h2o_vap) then
-               ! then there is no "water ice" tracer; but still
-               ! there is some water ice on the surface
-                 write(*,*)"          writing water ice instead"
-                 txt="h2o_ice"
-               else
-               ! there is a "water ice" tracer which has been / will be
-               ! delt with in due time
-                 cycle
-               endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
-             endif ! of if (txt.eq."h2o_vap")
-           ENDIF ! of IF (oldtracernames)
-
-           ierr=NF_REDEF(nid)
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, 'physdem0: Failed to swich to NetCDF define mode'
-             CALL abort
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr=NF_DEF_VAR(nid,txt,NF_DOUBLE,2,(/idim2,idim6/),nvarid)
-#else
-           ierr=NF_DEF_VAR(nid,txt,NF_FLOAT,2,(/idim2,idim6/),nvarid)
-#endif
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, 'physdem0: Failed to define ',trim(txt)
-             CALL abort
-           ENDIF
-           ierr=NF_PUT_ATT_TEXT (nid, nvarid, "title", 17,
-     &                        "tracer on surface")
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, 'physdem0: Failed to define ',trim(txt),
-     &               ' title attribute'
-             CALL abort
-           ENDIF
-           ierr=NF_ENDDEF(nid)
-           IF (ierr.NE.NF_NOERR) THEN
-             PRINT*, 'physdem0: Failed to swich out of define mode'
-             CALL abort
-           ENDIF
-         ENDDO
-      ENDIF
-           
-c close file
-      ierr = NF_CLOSE(nid)
-
-   
-      
-      END
-
-
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-
-
-
-      subroutine physdem1(filename,nsoil,ngrid,nlay,nq,
-     .                   phystep,time,
-     .                   tsurf,tsoil,co2ice,emis,q2,qsurf)
-      use infotrac, only: nqtot, tnom
-      implicit none
-c
-c Variables qui possèdent un axe des temps :
-c   tsurf
-c   tsoil
-c   co2ice
-c   q2
-c   qsurf
-c   emis (modifié dans newcondens --> co2snow)
-c       
-c-------------------------------------------------------------
-c
-c write physics (re-)start data file "restartfi.nc"
-c
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-c-----------------------------------------------------------------------
-#include "comvert.h"
-#include "comgeom2.h"
-#include "control.h"
-#include "comdissnew.h"
-#include "logic.h"
-#include "ener.h"
-#include "netcdf.inc"
-!#include "dimphys.h"
-!#include "advtrac.h"
-#include "callkeys.h"
-c
-      INTEGER nid,iq
-      INTEGER, parameter :: ivap=1
-      REAL, parameter :: qsolmax= 150.0
-      character (len=*) :: filename
-      character (len=7) :: str7
-
-      REAL day_ini
-      INTEGER,INTENT(IN) :: nsoil,ngrid,nlay,nq
-      integer ierr,nvarid
-
-c
-      REAL phystep,time
-!      REAL champhys(ngrid)
-      REAL tsurf(ngrid)
-
-      INTEGER nb
-      INTEGER edges(3),corner(3)
-
-
-
-c
-
-!      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
-!      EXTERNAL exner_hyb , SSUM
-c
-#include "serre.h"
-#include "clesph0.h"
-#include "fxyprim.h"
-!#include "comgeomfi.h"
-!#include "surfdat.h"
-!#include "comsoil.h"
-#include "planete.h"
-!#include "dimradmars.h"
-!#include "yomaer.h"
-#include "comcstfi.h"
-
-      real co2ice(ngrid),tsoil(ngrid,nsoil),emis(ngrid)
-      real q2(ngrid,nlay+1),qsurf(ngrid,nq)
-      integer ig
-
-! flag which identifies if we are using old tracer names (qsurf01,...)
-      logical,save :: oldtracernames=.false.
-      logical,save :: firstcall = .true.
-      integer :: count
-
-      character(len=30) :: txt ! to store some text
-! indexes of water vapour & water ice tracers (if any):
-      integer,save :: i_h2o_vap=0
-      integer,save :: i_h2o_ice=0
-c-----------------------------------------------------------------------
-
-
-      ierr = NF_OPEN(filename, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Pb. d ouverture "//filename
-         CALL abort
-      ENDIF
-
-c On a single run, different files can be written with physdem1.
-c Therefore, get the last time index from the file itself:
-      ierr = NF_INQ_DIMID(nid,"Time",nvarid)
-      ierr = NF_INQ_DIMLEN(nid,nvarid,nb)
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      ierr = NF_INQ_VARID(nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         print *, NF_STRERROR(ierr)
-         print*,'Variable Time n est pas definie'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture temps!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-      !PRINT*, "Enregistrement pour ", nb, time
-
-
-c Write the physical fields
-
-! Soil temperature
-      corner(1)=1
-      corner(2)=1
-      corner(3)=nb
-      edges(1)=ngrid
-      edges(2)=nsoil
-      edges(3)=1
-      ierr = NF_INQ_VARID(nid, "tsoil", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable tsoil n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,tsoil)
-#else
-      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,tsoil)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture tsoil!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-      
-
-c planetary boundary layer
-      corner(1)=1
-      corner(2)=1
-      corner(3)=nb
-      edges(1)=ngrid
-      edges(2)=llm+1
-      edges(3)=1
-      ierr = NF_INQ_VARID(nid, "q2", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable q2 n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,q2)
-#else
-      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,q2)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture q2!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-
-
-
-c Following corner and egdes are the same for co2ice,tsurf,qusrf,emis and tracers
-      corner(1)=1
-      corner(2)=nb
-      edges(1)=ngrid
-      edges(2)=1
-      
-! CO2 Ice Cover
-      ierr = NF_INQ_VARID(nid, "co2ice", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable co2ice n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,co2ice)
-#else
-      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,co2ice)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture co2ice!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-
-!  Surface temperature
-      ierr = NF_INQ_VARID(nid, "tsurf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable tsurf n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,tsurf)
-#else
-      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,tsurf)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture tsurf!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-
-
-c emissivity
-      ierr = NF_INQ_VARID(nid, "emis", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable emis n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,emis)
-#else
-      ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,emis)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         print*, "Erreur ecriture emis!!"
-         print*, NF_STRERROR(ierr)
-      ENDIF
-      
-
-c tracers
-
-! Preliminary stuff: check if tracers follow old naming convention (qsurf01,
-!                    qsurf02, ...)
-      IF (firstcall) THEN
-        count=0
-        do iq=1,nqtot
-          txt= " "
-          write(txt,'(a1,i2.2)')'q',iq
-          if (txt.ne.tnom(iq)) then ! use tracer names stored in dynamics
-            ! did not find old tracer name
-            exit ! might as well stop here
-          else
-            ! found old tracer name
-            count=count+1
-          endif
-        enddo
-        if (count.eq.nqtot) then
-          write(*,*) "physdem1:tracers seem to follow old naming ",
-     &               "convention (qsurf01,qsurf02,...)"
-          write(*,*) "  => will work for now ... "
-          write(*,*) "     but you should run newstart to rename them"
-          oldtracernames=.true.
-        endif ! of if (count.eq.nqtot)
-      ENDIF ! of if(firstcall)
-      
-      ! If computing water cycle with ice, move surface ice
-      ! back to qsurf(nqtot)
-      IF (oldtracernames .and. water) THEN
-       !"loop" to avoid potential out-of-bounds on arrays
-        write(*,*)'physdem1: moving surface water ice to index ',nqtot
-        do iq=nqtot,nqtot
-          qsurf(1:ngrid,iq)=qsurf(1:ngrid,iq-1)
-          qsurf(1:ngrid,iq-1)=0
-        enddo
-      ENDIF
-
-
-
-      IF(nq.GE.1) THEN
-      
-        IF (firstcall) THEN
-! preliminary stuff: look for water vapour & water ice tracers (if any)
-          if (.not.oldtracernames) then
-           do iq=1,nq
-             if (tnom(iq).eq."h2o_vap") then
-               i_h2o_vap=iq
-             endif
-             if (tnom(iq).eq."h2o_ice") then
-               i_h2o_ice=iq
-             endif
-           enddo ! of iq=1,nq
-           ! handle special case of only water vapour tracer (no ice)
-           if ((i_h2o_vap.ne.0).and.(i_h2o_ice.eq.0)) then
-            ! then the index of (surface) ice is i_h2o_vap
-            i_h2o_ice=i_h2o_vap
-           endif
-          endif ! of if (.not.oldtracernames)
-        ENDIF ! of if(firstcall)
-        firstcall = .false.
-
-
-        DO iq=1,nq
-           IF (oldtracernames) THEN
-             txt=" "
-             write(txt,'(a5,i2.2)')'qsurf',iq
-           ELSE
-             txt=tnom(iq)
-             ! Exception: there is no water vapour surface tracer
-             if (txt.eq."h2o_vap") then
-               if (i_h2o_ice.eq.i_h2o_vap) then
-               ! then there is no "water ice" tracer; but still
-               ! there is some water ice on the surface
-                 txt="h2o_ice"
-               else
-               ! there is a "water ice" tracer which has been / will be
-               ! delt with in due time
-                 cycle
-               endif ! of if (igcm_h2o_ice.eq.igcm_h2o_vap)
-             endif ! of if (txt.eq."h2o_vap")
-           ENDIF ! of IF (oldtracernames)
-
-
-
-           ierr = NF_INQ_VARID(nid, trim(txt), nvarid)
-           IF (ierr .NE. NF_NOERR) THEN
-              PRINT*, "Variable "//trim(txt)//" n est pas definie"
-              CALL abort
-           ENDIF
-#ifdef NC_DOUBLE
-           ierr = NF_PUT_VARA_DOUBLE (nid,nvarid,corner,edges,
-     .                                qsurf(:,iq))
-#else
-           ierr = NF_PUT_VARA_REAL (nid,nvarid,corner,edges,
-     .                              qsurf(:,iq))
-#endif
-           IF (ierr .NE. NF_NOERR) THEN
-              print*, "Erreur ecriture "//trim(txt)//"!!"
-              print*, NF_STRERROR(ierr)
-           ENDIF
-
-        ENDDO ! of DO iq=1,nq
-      ENDIF ! of IF(nq.GE.1)
-
-c close file
-      ierr = NF_CLOSE(nid)
-
-      RETURN
-
-      END
Index: trunk/LMDZ.MARS/libf/phymars/physiq.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/physiq.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/physiq.F	(revision 1130)
@@ -28,4 +28,6 @@
       use slope_mod, only: theta_sl, psi_sl
       use conc_mod, only: rnew, cpnew, mmean
+      use control_mod, only: iphysiq, day_step, ecritstart
+      use phyredem, only: physdem0, physdem1
 
 #ifdef MESOSCALE
@@ -144,5 +146,5 @@
 #include "planete.h"
 !#include "comsaison.h"
-#include "control.h"
+!#include "control.h"
 !#include "dimradmars.h"
 ! naerkind is set in scatterers.h (built when compiling with makegcm -s #)
@@ -515,9 +517,10 @@
 #ifndef MESOSCALE
          if (callslope) call getslopes(ngrid,phisfi)
-                           
+
+         if (ngrid.ne.1) then ! no need to create a restart file in 1d
          call physdem0("restartfi.nc",long,lati,nsoilmx,ngrid,nlayer,nq,
      .                 ptimestep,pday,time_phys,area,
      .                 albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-     
+         endif
 #endif
                    
@@ -676,5 +679,4 @@
 c          Radiative transfer
 c          ------------------
-
            CALL callradite(icount,ngrid,nlayer,nq,zday,zls,pq,albedo,
      $     emis,mu0,zplev,zplay,pt,tsurf,fract,dist_sol,igout,
@@ -1036,5 +1038,5 @@
      &                nq,tau,tauscaling,rdust,rice,nuice,
      &                rsedcloud,rhocloud)
-
+     
 c Temperature variation due to latent heat release
            if (activice) then
@@ -1135,7 +1137,5 @@
 c        ------------- 
          IF (sedimentation) THEN 
-           !call zerophys(ngrid*nlayer*nq, zdqsed)
            zdqsed(1:ngrid,1:nlayer,1:nq)=0
-           !call zerophys(ngrid*nq, zdqssed)
            zdqssed(1:ngrid,1:nq)=0
 
@@ -2073,10 +2073,12 @@
      &                       'Mean reff',
      &                       'm',2,rave)
-            CALL WRITEDIAGFI(ngrid,"Nccntot",
+            if (scavenging) then
+              CALL WRITEDIAGFI(ngrid,"Nccntot",
      &                    "condensation nuclei","Nbr/m2",
      &                    2,Nccntot)
-            CALL WRITEDIAGFI(ngrid,"Mccntot",
+              CALL WRITEDIAGFI(ngrid,"Mccntot",
      &                    "mass condensation nuclei","kg/m2",
      &                    2,Mccntot)
+            endif
             call WRITEDIAGFI(ngrid,'rice','Ice particle size',
      &                       'm',3,rice)
Index: trunk/LMDZ.MARS/libf/phymars/planete.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/planete.h	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/planete.h	(revision 1130)
@@ -1,4 +1,4 @@
-c-----------------------------------------------------------------------
-c INCLUDE planet.h
+!-----------------------------------------------------------------------
+! INCLUDE planet.h
 
       COMMON/planet/aphelie,periheli,year_day,peri_day,                 &
@@ -12,3 +12,3 @@
      &       timeperi,e_elips,p_elips,unitastr
 
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
Index: trunk/LMDZ.MARS/libf/phymars/planetwide_mod.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/planetwide_mod.F90	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/planetwide_mod.F90	(revision 1130)
@@ -0,0 +1,203 @@
+!
+! $Id: $
+!
+module planetwide_mod
+! module which contains functions to obtain max/min/... values over the
+! entire globe (trivial in serial mode, but not in parallel)
+
+use mod_phys_lmdz_para, only : is_master, gather, bcast
+                               
+implicit none
+
+interface planetwide_maxval ! maxval() , over the entire planet
+  module procedure planetwide_maxval_i1, planetwide_maxval_i2, &
+                   planetwide_maxval_r1, planetwide_maxval_r2
+end interface
+
+interface planetwide_minval ! minval() , over the entire planet
+  module procedure planetwide_minval_i1, planetwide_minval_i2, &
+                   planetwide_minval_r1, planetwide_minval_r2
+end interface
+
+contains
+
+  subroutine planetwide_maxval_i1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:) ! local grid (klon)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_i1
+
+  subroutine planetwide_maxval_i2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:,:) ! local grid (klon,klev)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_i2
+
+  subroutine planetwide_maxval_r1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:) ! local grid (klon)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_r1
+
+  subroutine planetwide_maxval_r2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:,:) ! local grid (klon,klev)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=maxval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=maxval(values)
+#endif
+  end subroutine planetwide_maxval_r2
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  subroutine planetwide_minval_i1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:) ! local grid (klon)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_i1
+
+  subroutine planetwide_minval_i2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  integer,intent(in) :: values(:,:) ! local grid (klon,klev)
+  integer,intent(out) :: values_max
+#ifdef CPP_PARA
+  integer :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_i2
+
+  subroutine planetwide_minval_r1(values,values_max)
+  use dimphy, only: klon
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:) ! local grid (klon)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_r1
+
+  subroutine planetwide_minval_r2(values,values_max)
+  use dimphy, only: klon, klev
+  use mod_grid_phy_lmdz, only : klon_glo
+  implicit none
+  real,intent(in) :: values(:,:) ! local grid (klon,klev)
+  real,intent(out) :: values_max
+#ifdef CPP_PARA
+  real :: values_glo(klon_glo,klev) ! global grid
+  
+  ! gather field on master:
+  call gather(values,values_glo)
+  ! extract maximum value
+  if (is_master) then
+    values_max=minval(values_glo)
+  endif
+  ! broadcast information to all cores
+  call bcast(values_max)
+#else
+  values_max=minval(values)
+#endif
+  end subroutine planetwide_minval_r2
+
+
+end module planetwide_mod
Index: trunk/LMDZ.MARS/libf/phymars/soil_settings.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/soil_settings.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/soil_settings.F	(revision 1130)
@@ -1,6 +1,8 @@
       subroutine soil_settings(nid,ngrid,nsoil,tsurf,tsoil,indextime)
 
-      use netcdf
+!      use netcdf
       use comsoil_h, only: layer, mlayer, inertiedat, volcapa
+      use iostart, only: inquire_field_ndims, get_var, get_field,
+     &                   inquire_field, inquire_dimension_length
       implicit none
 
@@ -74,4 +76,6 @@
       real,parameter :: default_volcapa=1.e6
 
+      logical :: found,ok
+      
 !======================================================================
 
@@ -81,18 +85,19 @@
 ! 1.1 Start by reading how many layers of soil there are
 
-	ierr=nf90_inq_dimid(nid,"subsurface_layers",dimid)
-	if (ierr.ne.nf90_noerr) then
-	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
-         write(*,*)trim(nf90_strerror(ierr))
-	 call abort
-	endif
-
-	ierr=nf90_inquire_dimension(nid,dimid,len=dimlen)
-	if (ierr.ne.nf90_noerr) then
-	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
-     &             'length'
-	 write(*,*)trim(nf90_strerror(ierr))
-         call abort
-	endif
+!	ierr=nf90_inq_dimid(nid,"subsurface_layers",dimid)
+!	if (ierr.ne.nf90_noerr) then
+!	 write(*,*)'soil_settings: Problem reading <subsurface_layers>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!	 call abort
+!	endif
+
+!	ierr=nf90_inquire_dimension(nid,dimid,len=dimlen)
+!	if (ierr.ne.nf90_noerr) then
+!	 write(*,*)'soil_settings: Problem getting <subsurface_layers>',
+!     &             'length'
+!	 write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+!	endif
+        dimlen=inquire_dimension_length("subsurface_layers")
 
         if (dimlen.ne.nsoil) then
@@ -107,14 +112,15 @@
 !     (in ye old days, thermal inertia was only given at the "surface")
       ! Look for thermal inertia data
-      ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*)'soil_settings: Field <inertiedat> not found!'
-         write(*,*)trim(nf90_strerror(ierr))
-         call abort
-      endif
-
-      ! Read the # of dimensions <inertidat> was defined as using
-      ierr=nf90_inquire_variable(nid,nvarid,ndims=ndims)
-      ! if (ndims.eq.1) then we have the "old 2D-surface" format
+!      ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
+!      if (ierr.NE.nf90_noerr) then
+!         write(*,*)'soil_settings: Field <inertiedat> not found!'
+!         write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+!      endif
+!
+!      ! Read the # of dimensions <inertidat> was defined as using
+!      ierr=nf90_inquire_variable(nid,nvarid,ndims=ndims)
+!      ! if (ndims.eq.1) then we have the "old 2D-surface" format
+      ndims=inquire_field_ndims("inertiedat")
 
 ! 1.3 Read depths values or set olddepthdef flag and values
@@ -136,24 +142,32 @@
 	enddo
       else ! Look for depth 
-        ierr=nf90_inq_varid(nid,"soildepth",nvarid)
-        if (ierr.ne.nf90_noerr) then
-          write(*,*)'soil_settings: Field <soildepth> not found!'
-          write(*,*)trim(nf90_strerror(ierr))
-	  call abort
-        endif
+!        ierr=nf90_inq_varid(nid,"soildepth",nvarid)
+!        if (ierr.ne.nf90_noerr) then
+!          write(*,*)'soil_settings: Field <soildepth> not found!'
+!          write(*,*)trim(nf90_strerror(ierr))
+!	  call abort
+!        endif
         ! read <depth> coordinate
         if (interpol) then !put values in oldmlayer
-          ierr=nf90_get_var(nid,nvarid,oldmlayer)
-          if (ierr.ne.nf90_noerr) then
-           write(*,*)'soil_settings: Problem while reading <soildepth>'
-           write(*,*)trim(nf90_strerror(ierr))
-           call abort
+!          ierr=nf90_get_var(nid,nvarid,oldmlayer)
+!          if (ierr.ne.nf90_noerr) then
+!           write(*,*)'soil_settings: Problem while reading <soildepth>'
+!           write(*,*)trim(nf90_strerror(ierr))
+!           call abort
+!          endif
+          call get_var("soildepth",oldmlayer,found)
+          if (.not.found) then
+            write(*,*)'soil_settings: Problem while reading <soildepth>'
           endif
         else ! put values in mlayer
-          ierr=nf90_get_var(nid,nvarid,mlayer)
-          if (ierr.ne.nf90_noerr) then
-           write(*,*)'soil_settings: Problem while reading <soildepth>'
-           write(*,*)trim(nf90_strerror(ierr))
-           call abort
+!          ierr=nf90_get_var(nid,nvarid,mlayer)
+!          if (ierr.ne.nf90_noerr) then
+!           write(*,*)'soil_settings: Problem while reading <soildepth>'
+!           write(*,*)trim(nf90_strerror(ierr))
+!           call abort
+!          endif
+          call get_var("soildepth",mlayer,found)
+          if (.not.found) then
+            write(*,*)'soil_settings: Problem while reading <soildepth>'
           endif
         endif !of if (interpol)
@@ -217,10 +231,10 @@
 
 ! 3.1 Look (again) for thermal inertia data (to reset nvarid)
-      ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
-      if (ierr.NE.nf90_noerr) then
-         write(*,*)'soil_settings: Field <inertiedat> not found!'
-         write(*,*)trim(nf90_strerror(ierr))
-         call abort
-      endif
+!      ierr=nf90_inq_varid(nid,"inertiedat",nvarid)
+!      if (ierr.NE.nf90_noerr) then
+!         write(*,*)'soil_settings: Field <inertiedat> not found!'
+!         write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+!      endif
 
 ! 3.2 Knowing the # of dimensions <inertidat> was defined as using,
@@ -232,10 +246,15 @@
        ! Read Surface thermal inertia
        allocate(surfinertia(ngrid))
-       ierr=nf90_get_var(nid,nvarid,surfinertia)
-        if (ierr.NE.nf90_noerr) then
-         write(*,*)'soil_settings: Problem while reading <inertiedat>'
-         write(*,*)trim(nf90_strerror(ierr))
+!       ierr=nf90_get_var(nid,nvarid,surfinertia)
+!        if (ierr.NE.nf90_noerr) then
+!         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+!        endif
+       call get_field("inertiedat",surfinertia,found)
+       if (.not.found) then
+         write(*,*) "soil_settings: Failed loading <inertiedat>"
          call abort
-        endif
+       endif
        
        write(*,*)' => Building soil thermal inertia (using reference sur
@@ -255,18 +274,28 @@
             stop
            endif
-         endif
-         ierr=nf90_get_var(nid,nvarid,oldinertiedat)
-        if (ierr.NE.nf90_noerr) then
-         write(*,*)'soil_settings: Problem while reading <inertiedat>'
-         write(*,*)trim(nf90_strerror(ierr))
-         call abort
+         endif ! of if (.not.allocated(oldinertiedat))
+!         ierr=nf90_get_var(nid,nvarid,oldinertiedat)
+!        if (ierr.NE.nf90_noerr) then
+!         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+!        endif
+        call get_field("inertiedat",oldinertiedat,found)
+        if (.not.found) then
+          write(*,*) "soil_settings: Failed loading <inertiedat>"
+          call abort
         endif
        else ! put values in therm_i
-        ierr=nf90_get_var(nid,nvarid,inertiedat)
-        if (ierr.NE.nf90_noerr) then
-         write(*,*)'soil_settings: Problem while reading <inertiedat>'
-         write(*,*)trim(nf90_strerror(ierr))
-         call abort
-        endif
+!        ierr=nf90_get_var(nid,nvarid,inertiedat)
+!        if (ierr.NE.nf90_noerr) then
+!         write(*,*)'soil_settings: Problem while reading <inertiedat>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!         call abort
+         call get_field("inertiedat",inertiedat,found)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <inertiedat>"
+           call abort
+         endif
+!        endif
        endif ! of if (interpol)
       endif ! of if (ndims.eq.1)
@@ -275,6 +304,8 @@
 ! -------------------------
 
-      ierr=nf90_inq_varid(nid,"tsoil",nvarid)
-      if (ierr.ne.nf90_noerr) then
+!      ierr=nf90_inq_varid(nid,"tsoil",nvarid)
+      ok=inquire_field("tsoil")
+!      if (ierr.ne.nf90_noerr) then
+      if (.not.ok) then
         write(*,*)'soil_settings: Field <tsoil> not found!'
 	write(*,*)' => Building <tsoil> from surface values <tsurf>'
@@ -292,26 +323,36 @@
            endif
          endif
-        ierr=nf90_get_var(nid,nvarid,oldtsoil)
-        if (ierr.ne.nf90_noerr) then
-	 write(*,*)'soil_settings: Problem while reading <tsoil>'
-         write(*,*)trim(nf90_strerror(ierr))
-	 call abort
-	endif
+!        ierr=nf90_get_var(nid,nvarid,oldtsoil)
+!        if (ierr.ne.nf90_noerr) then
+!	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!	 call abort
+!	endif
+         call get_field("tsoil",oldtsoil,found)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <tsoil>"
+           call abort
+         endif
        else ! put values in tsoil
-        corner(1)=1
-        corner(2)=1
-        corner(3)=indextime
-        edges(1)=ngrid
-        edges(2)=nsoil
-        edges(3)=1
-        !ierr=nf90_get_var(nid,nvarid,tsoil,corner,edges)
-        ierr=nf90_get_var(nid,nvarid,tsoil)
-        if (ierr.ne.nf90_noerr) then
-	 write(*,*)'soil_settings: Problem while reading <tsoil>'
-         write(*,*)trim(nf90_strerror(ierr))
-	 call abort
-	endif
+!        corner(1)=1
+!        corner(2)=1
+!        corner(3)=indextime
+!        edges(1)=ngrid
+!        edges(2)=nsoil
+!        edges(3)=1
+!        !ierr=nf90_get_var(nid,nvarid,tsoil,corner,edges)
+!        ierr=nf90_get_var(nid,nvarid,tsoil)
+!        if (ierr.ne.nf90_noerr) then
+!	 write(*,*)'soil_settings: Problem while reading <tsoil>'
+!         write(*,*)trim(nf90_strerror(ierr))
+!	 call abort
+!	endif
+         call get_field("tsoil",tsoil,found,timeindex=indextime)
+         if (.not.found) then
+           write(*,*) "soil_settings: Failed loading <tsoil>"
+           call abort
+         endif
        endif ! of if (interpol) 
-      endif
+      endif! of if (.not.ok)
 
 ! 5. If necessary, interpolate soil temperatures and thermal inertias
Index: trunk/LMDZ.MARS/libf/phymars/start2archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/start2archive.F	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/start2archive.F	(revision 1130)
@@ -0,0 +1,412 @@
+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
+      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 "control.h"
+#include "ener.h"
+#include "description.h"
+
+!#include "dimphys.h"
+!#include "comsoil.h"
+!#include"advtrac.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL q2(ngridmx,llm+1)
+      REAL,ALLOCATABLE :: qsurf(:,:)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      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 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(qsurf(ngridmx,nqtot))
+      allocate(qsurfS(ip1jmp1,nqtot))
+      call ini_surfdat_h(ngridmx)
+      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)
+
+       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
+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)
+
+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,'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/surfini.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/surfini.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/surfini.F	(revision 1130)
@@ -8,4 +8,6 @@
      &                     albedo_h2o_ice, inert_h2o_ice, albedodat,
      &                     albedice
+      use mod_grid_phy_lmdz, only : klon_glo ! # of physics point on full grid
+      use mod_phys_lmdz_para, only : is_master, gather, scatter
       IMPLICIT NONE
 c=======================================================================
@@ -27,14 +29,14 @@
 #include "datafile.h"
 
-      INTEGER ngrid,ig,icap,iq,alternate
-      REAL  piceco2(ngrid),psolaralb(ngrid,2)
-      REAL qsurf(ngrid,nqmx) !tracer on surface (kg/m2)
+      integer,intent(in) :: ngrid ! number of atmospheric columns
+      real,intent(in) :: piceco2(ngrid) ! CO2 ice thickness
+      real,intent(inout) :: qsurf(ngrid,nqmx) ! tracer on surface (kg/m2)
+      real,intent(out) :: psolaralb(ngrid,2) ! albedo
+
+      INTEGER ig,icap,iq,alternate
       REAL icedryness ! ice dryness
       
       ! longwatercaptag is watercaptag. Trick for some compilers
       LOGICAL, DIMENSION(100000) :: longwatercaptag
-
-      EXTERNAL ISMIN,ISMAX
-      INTEGER ISMIN,ISMAX
       
 ! There are 3 different modes for ice distribution:
@@ -53,5 +55,9 @@
       REAL        zelat,zelon 
 
+#ifdef CPP_PARA
       INTEGER nb_ice(ngrid,2)              ! number of counts | detected ice for GCM grid
+#else
+      INTEGER nb_ice(klon_glo,2)
+#endif
       INTEGER latice(jjm,2),lonice (iim,2) ! number of counts | detected ice along lat & lon axis
 
@@ -64,6 +70,22 @@
       
       character (len=100) :: zedatafile
+
+      ! to handle parallel cases
+#if CPP_PARA
+      logical watercaptag_glo(klon_glo)
+      real dryness_glo(klon_glo)
+      real lati_glo(klon_glo)
+      real long_glo(klon_glo)
+#else
+      logical watercaptag_glo(ngrid)
+      real dryness_glo(ngrid)
+      real lati_glo(ngrid)
+      real long_glo(ngrid)
+#endif
+
 c
 c=======================================================================
+! Initialize watercaptag (default is false)
+      watercaptag_glo(:)=.false.
 
 c     water ice outliers
@@ -93,8 +115,8 @@
          endif
          
-         write(*,*) "Ice dryness ?"
+         write(*,*) "surfini: Ice dryness ?"
          icedryness=1. ! default value
          call getin("icedryness",icedryness)
-         write(*,*) " icedryness = ",icedryness
+         write(*,*) "surfini: icedryness = ",icedryness
          dryness (:) = icedryness
          
@@ -125,11 +147,19 @@
 #else
 
-
-
-      IF (ngrid .eq. 1) THEN ! special case for 1d --> do nothing
+      ! To be able to run in parallel, we work on the full grid
+      ! and dispatch results afterwards
+
+      ! start by geting latitudes and logitudes on full grid
+      ! (in serial mode, this is just a copy)
+      call gather(lati,lati_glo)
+      call gather(long,long_glo)
+
+      if (is_master) then
+
+        IF (ngrid .eq. 1) THEN ! special case for 1d --> do nothing
       
          print*, 'ngrid = 1, do no put ice caps in surfini.F'
 
-      ELSE IF (icelocationmode .eq. 1) THEN
+        ELSE IF (icelocationmode .eq. 1) THEN
       
          print*,'Surfini: ice caps defined from surface.nc'
@@ -144,11 +174,11 @@
 
            
-        zedatafile = trim(datafile)
+         zedatafile = trim(datafile)
  
         
-        ierr=nf90_open(trim(zedatafile)//'/surface.nc',
-     &  NF90_NOWRITE,nid)
+         ierr=nf90_open(trim(zedatafile)//'/surface.nc',
+     &   NF90_NOWRITE,nid)
      
-      IF (ierr.NE.nf90_noerr) THEN
+         IF (ierr.NE.nf90_noerr) THEN
        write(*,*)'Error : cannot open file surface.nc '
        write(*,*)'(in phymars/surfini.F)'
@@ -160,45 +190,45 @@
        write(*,*)' http://www.lmd.jussieu.fr/~forget/datagcm/datafile'
        CALL ABORT
-      ENDIF
-      
-      
-      ierr=nf90_inq_varid(nid, string, nvarid)
-      if (ierr.ne.nf90_noerr) then
-        write(*,*) 'surfini error, cannot find ',trim(string)
-        write(*,*) ' in file ',trim(zedatafile),'/surface.nc'
-        write(*,*)trim(nf90_strerror(ierr))
-        stop
-      endif
-
-      ierr=nf90_get_var(nid, nvarid, zdata)
-
-      if (ierr.ne.nf90_noerr) then
-        write(*,*) 'surfini: error failed loading ',trim(string)
-        write(*,*)trim(nf90_strerror(ierr))
-        stop
-      endif
+         ENDIF
+      
+      
+         ierr=nf90_inq_varid(nid, string, nvarid)
+         if (ierr.ne.nf90_noerr) then
+          write(*,*) 'surfini error, cannot find ',trim(string)
+          write(*,*) ' in file ',trim(zedatafile),'/surface.nc'
+          write(*,*)trim(nf90_strerror(ierr))
+          stop
+         endif
+
+         ierr=nf90_get_var(nid, nvarid, zdata)
+
+         if (ierr.ne.nf90_noerr) then
+          write(*,*) 'surfini: error failed loading ',trim(string)
+          write(*,*)trim(nf90_strerror(ierr))
+          stop
+         endif
  
                      
-      ierr=nf90_close(nid)
+         ierr=nf90_close(nid)
  
 
-      nb_ice(:,1) = 1 ! default: there is no ice
-      latice(:,1) = 1
-      lonice(:,1) = 1
-      nb_ice(:,2) = 0
-      latice(:,2) = 0
-      lonice(:,2) = 0
-      !print*,'jjm,iim',jjm,iim ! jjm =  nb lati , iim = nb longi
-
-      ! loop over the GCM grid - except for poles (ig=1 and ngrid)
-      do ig=2,ngrid-1
-      
-        ! loop over the surface file grid      
-        do i=1,imd
-          do j=1,jmd
-            zelon = i - 180.
-            zelat = 90. - j 
-            if ((abs(lati(ig)*180./pi-zelat) .le. 90./real(jjm)) .and.
-     &        (abs(long(ig)*180./pi-zelon) .le. 180./real(iim))) then
+         nb_ice(:,1) = 1 ! default: there is no ice
+         latice(:,1) = 1
+         lonice(:,1) = 1
+         nb_ice(:,2) = 0
+         latice(:,2) = 0
+         lonice(:,2) = 0
+         !print*,'jjm,iim',jjm,iim ! jjm =  nb lati , iim = nb longi
+
+         ! loop over the GCM grid - except for poles (ig=1 and ngrid)
+         do ig=2,klon_glo-1
+      
+          ! loop over the surface file grid      
+          do i=1,imd
+           do j=1,jmd
+             zelon = i - 180.
+             zelat = 90. - j 
+            if ((abs(lati_glo(ig)*180./pi-zelat).le.90./real(jjm)) .and.
+     &        (abs(long_glo(ig)*180./pi-zelon).le.180./real(iim))) then
               ! count all points in that GCM grid point
               nb_ice(ig,1) = nb_ice(ig,1) + 1
@@ -207,23 +237,23 @@
      &           nb_ice(ig,2) = nb_ice(ig,2) + 1
              endif
-          enddo
-        enddo  
+           enddo
+          enddo  
 
         ! projection of nb_ice on GCM lat and lon axes
-        latice(1+(ig-2)/iim,:) =
+          latice(1+(ig-2)/iim,:) =
      &     latice(1+(ig-2)/iim,:) + nb_ice(ig,:)
-        lonice(1+mod(ig-2,iim),:) = 
+          lonice(1+mod(ig-2,iim),:) = 
      &     lonice(1+mod(ig-2,iim),:) + nb_ice(ig,:) ! lonice is USELESS ...
 
-      enddo ! of do ig=2,ngrid-1
+         enddo ! of do ig=2,klon_glo-1
      
 
      
-      ! special case for poles
-      nb_ice(1,2)   = 1  ! ice prescribed on north pole
-      latice(1,:)   = nb_ice(1,:)
-      lonice(1,:)   = nb_ice(1,:)
-      latice(jjm,:) = nb_ice(ngrid,:)
-      lonice(iim,:) = nb_ice(ngrid,:)
+         ! special case for poles
+         nb_ice(1,2)   = 1  ! ice prescribed on north pole
+         latice(1,:)   = nb_ice(1,:)
+         lonice(1,:)   = nb_ice(1,:)
+         latice(jjm,:) = nb_ice(ngrid,:)
+         lonice(iim,:) = nb_ice(ngrid,:)
       
      
@@ -241,39 +271,39 @@
       
     
-      ! loop over GCM latitudes. CONSIDER ONLY NORTHERN HEMISPHERE
-      do i=1,jjm/2
-      step  = 1. ! threshold to add ice cap
-      count = 0. ! number of ice GCM caps at this latitude
-      ! ratiolat is the ratio of area covered by ice within this GCM latitude range
-      ratiolat  = real(latice(i,2))/real(latice(i,1))
-      !print*,'i',i,(i-1)*iim+2,i*iim+1
+         ! loop over GCM latitudes. CONSIDER ONLY NORTHERN HEMISPHERE
+         do i=1,jjm/2
+          step  = 1. ! threshold to add ice cap
+          count = 0. ! number of ice GCM caps at this latitude
+          ! ratiolat is the ratio of area covered by ice within this GCM latitude range
+          ratiolat  = real(latice(i,2))/real(latice(i,1))
+          !print*,'i',i,(i-1)*iim+2,i*iim+1
      
-        ! put ice caps while there is not enough ice,
-        ! as long as the threshold is above 20%
-        do while ( (count .le. ratiolat*iim ) .and. (step .ge. 0.2))
-          count = 0.
-          ! loop over GCM longitudes
-          do j=1,iim
+          ! put ice caps while there is not enough ice,
+          ! as long as the threshold is above 20%
+          do while ( (count .le. ratiolat*iim ) .and. (step .ge. 0.2))
+           count = 0.
+           ! loop over GCM longitudes
+           do j=1,iim
             ! if the detected ice ratio in the GCM grid point 
             ! is more than 'step', then add ice
             if (real(nb_ice((i-1)*iim+1+j,2)) 
      &        / real(nb_ice((i-1)*iim+1+j,1)) .ge. step) then
-                  watercaptag((i-1)*iim+1+j) = .true.
+                  watercaptag_glo((i-1)*iim+1+j) = .true.
                   count = count + 1
             endif
-          enddo ! of do j=1,iim
+           enddo ! of do j=1,iim
+           !print*, 'step',step,count,ratiolat*iim
+           step = step - 0.01
+          enddo ! of do while
           !print*, 'step',step,count,ratiolat*iim
-          step = step - 0.01
-        enddo ! of do while
-      !print*, 'step',step,count,ratiolat*iim
-
-      enddo ! of do i=1,jjm/2
+
+         enddo ! of do i=1,jjm/2
             
 
-      ELSE IF (icelocationmode .eq. 2) THEN
-      
-        print*,'Surfini: predefined ice caps'
-      
-        if ((iim .eq. 32) .and. (jjm .eq. 24)) then ! 32x24
+        ELSE IF (icelocationmode .eq. 2) THEN
+      
+         print*,'Surfini: predefined ice caps'
+      
+         if ((iim .eq. 32) .and. (jjm .eq. 24)) then ! 32x24
            
           print*,'water ice caps distribution for 32x24 resolution'
@@ -288,5 +318,5 @@
 !---------------------   OUTLIERS  ----------------------------
 
-        else if ((iim .eq. 64) .and. (jjm .eq. 48)) then ! 64x48
+         else if ((iim .eq. 64) .and. (jjm .eq. 48)) then ! 64x48
 
           print*,'water ice caps distribution for 64x48 resolution'
@@ -323,42 +353,43 @@
 
             
-        else if (ngrid .ne. 1) then
+         else if (klon_glo .ne. 1) then
         
-      print*,'No predefined ice location for this resolution :',iim,jjm
-      print*,'Please change icelocationmode in surfini.F'
-      print*,'Or add some new definitions ...'
-      call abort
+          print*,'No predefined ice location for this resolution :',
+     &           iim,jjm
+          print*,'Please change icelocationmode in surfini.F'
+          print*,'Or add some new definitions ...'
+          call abort
           
-        endif
-
-        do ig=1,ngrid
-          if (longwatercaptag(ig)) watercaptag(ig) = .true.
-        enddo
-
-
-      ELSE IF (icelocationmode .eq. 3) THEN
-      
-        print*,'Surfini: ice caps defined by lat and lon values'
-
-         do ig=1,ngrid
+         endif
+
+         do ig=1,klon_glo
+          if (longwatercaptag(ig)) watercaptag_glo(ig) = .true.
+         enddo
+
+
+        ELSE IF (icelocationmode .eq. 3) THEN
+      
+         print*,'Surfini: ice caps defined by lat and lon values'
+
+         do ig=1,klon_glo
          
 c-------- Towards olympia planitia water caps -----------
 c-------------------------------------------------------- 
 
-       if ( ( ( lati(ig)*180./pi .ge. 77.  ) .and. ! cap #2
-     .           ( lati(ig)*180./pi .le. 80.  ) .and.
-     .           ( long(ig)*180./pi .ge. 110. ) .and.
-     .           ( long(ig)*180./pi .le. 181. ) )
+          if ( ( ( lati_glo(ig)*180./pi .ge. 77.  ) .and. ! cap #2
+     .           ( lati_glo(ig)*180./pi .le. 80.  ) .and.
+     .           ( long_glo(ig)*180./pi .ge. 110. ) .and.
+     .           ( long_glo(ig)*180./pi .le. 181. ) )
      .         .or.
 
-     .         ( ( lati(ig)*180./pi .ge. 75.  ) .and. ! cap #4 (Korolev crater)
-     .           ( lati(ig)*180./pi .le. 76.  ) .and.
-     .           ( long(ig)*180./pi .ge. 150. ) .and.
-     .           ( long(ig)*180./pi .le. 168. ) )
+     .         ( ( lati_glo(ig)*180./pi .ge. 75.  ) .and. ! cap #4 (Korolev crater)
+     .           ( lati_glo(ig)*180./pi .le. 76.  ) .and.
+     .           ( long_glo(ig)*180./pi .ge. 150. ) .and.
+     .           ( long_glo(ig)*180./pi .le. 168. ) )
      .         .or.
-     .         ( ( lati(ig)*180./pi .ge. 77 ) .and. ! cap #5
-     .           ( lati(ig)*180./pi .le. 80.  ) .and.
-     .           ( long(ig)*180./pi .ge. -150.) .and.
-     .           ( long(ig)*180./pi .le. -110.) ) )
+     .         ( ( lati_glo(ig)*180./pi .ge. 77 ) .and. ! cap #5
+     .           ( lati_glo(ig)*180./pi .le. 80.  ) .and.
+     .           ( long_glo(ig)*180./pi .ge. -150.) .and.
+     .           ( long_glo(ig)*180./pi .le. -110.) ) )
      .         then
              
@@ -370,20 +401,20 @@
                endif !end if alternate = 0
                
-       endif
+          endif
 
 c----------- Opposite olympia planitia water cap --------
 c-------------------------------------------------------- 
 
-        if ( ( ( lati(ig)*180./pi     .ge.  80 ) .and.
-     .         ( lati(ig)*180./pi     .le.  84 ) )
+          if ( ( ( lati_glo(ig)*180./pi     .ge.  80 ) .and.
+     .         ( lati_glo(ig)*180./pi     .le.  84 ) )
      .         .and.
-     .       ( ( long(ig)*180./pi .lt. -95. ) .or.       !!! 32x24
-     .         ( long(ig)*180./pi .gt.  85. ) ) ) then   !!! 32x24
-!     .     ( ( ( long(ig)*180./pi .ge. -29. ) .and.       !!! 64x48
-!     .         ( long(ig)*180./pi .le.  90. ) ) .or.      !!! 64x48
-!     .       ( ( long(ig)*180./pi .ge. -77. ) .and.       !!! 64x48
-!     .         ( long(ig)*180./pi .le. -70. ) ) ) ) then  !!! 64x48
-        !   watercaptag(ig)=.true.
-        endif
+     .       ( ( long_glo(ig)*180./pi .lt. -95. ) .or.       !!! 32x24
+     .         ( long_glo(ig)*180./pi .gt.  85. ) ) ) then   !!! 32x24
+!     .     ( ( ( long_glo(ig)*180./pi .ge. -29. ) .and.       !!! 64x48
+!     .         ( long_glo(ig)*180./pi .le.  90. ) ) .or.      !!! 64x48
+!     .       ( ( long_glo(ig)*180./pi .ge. -77. ) .and.       !!! 64x48
+!     .         ( long_glo(ig)*180./pi .le. -70. ) ) ) ) then  !!! 64x48
+        !   watercaptag_glo(ig)=.true.
+          endif
 
 
@@ -391,13 +422,13 @@
 c-------------------------------------------------------- 
 
-      if (abs(lati(ig)*180./pi).gt.80)
-     .       watercaptag(ig)=.true.
+          if (abs(lati_glo(ig)*180./pi).gt.80)
+     .          watercaptag_glo(ig)=.true.
            
 c--------------------------------------------------------
 c--------------------------------------------------------
-      end do ! of (ngrid)
-
-
-       ELSE
+         end do ! of (klon_glo)
+
+
+        ELSE
       
          print*, 'In surfini.F, icelocationmode is ', icelocationmode
@@ -405,20 +436,27 @@
          call abort 
 
-       ENDIF ! of if (icelocation)
+        ENDIF ! of if (icelocation)
        
        
         ! print caps locations - useful for plots too 
-        print*,'latitude | longitude | ig'
-        do ig=1,ngrid
-          dryness (ig) = icedryness
-
-          if (watercaptag(ig)) then
-             print*,'ice water cap', lati(ig)*180./pi,
-     .              long(ig)*180./pi, ig
+        print*,'surfini: latitude | longitude | ig'
+        do ig=1,klon_glo
+          dryness_glo(ig) = icedryness
+
+          if (watercaptag_glo(ig)) then
+             print*,'surfini: ice water cap', lati_glo(ig)*180./pi,
+     &              long_glo(ig)*180./pi, ig
           endif
         enddo
        
+       endif !of if (is_master)
+       
+       ! Now scatter fields watercaptag and dryness from master to all
+       ! (is just a plain copy in serial mode)
+       call scatter(dryness_glo,dryness)
+       call scatter(watercaptag_glo,watercaptag)
+       
 #endif      
-
+! end of #else of #ifdef MESOSCALE
        ENDIF ! (caps & water)
        
@@ -439,8 +477,8 @@
               psolaralb(ig,2)=albedodat(ig)
          END DO
-         PRINT*,'minimum albedo sans water caps',
-     s     albedodat(ISMIN(ngrid,albedodat,1))
-         PRINT*,'maximum albedo sans water caps',
-     s     albedodat(ISMAX(ngrid,albedodat,1))
+         PRINT*,'surfini: minimum albedo without water caps',
+     &          minval(albedodat)
+         PRINT*,'surfini: maximum albedo without water caps',
+     &          maxval(albedodat)
 
 c        initial albedo if permanent H2O ice is present 
@@ -453,8 +491,8 @@
             ENDIF
            END DO
-           PRINT*,'minimum albedo avec water caps',
-     s     psolaralb(ISMIN(ngrid,psolaralb,1),1)
-           PRINT*,'maximum albedo avec water caps',
-     s     psolaralb(ISMAX(ngrid,psolaralb,1),1)
+           PRINT*,'surfini: minimum albedo with water caps',
+     &            minval(albedodat)
+           PRINT*,'surfini: maximum albedo with water caps',
+     &            maxval(albedodat)
 
          ENDIF
@@ -465,8 +503,8 @@
        DO ig=1,ngrid
          IF (piceco2(ig) .GT. 0.) THEN
-             IF(ig.GT.ngrid/2+1) THEN
-                icap=2
+             IF(lati(ig).LT. 0.) THEN
+                icap=2 ! Southern hemisphere
              ELSE
-                icap=1
+                icap=1 ! Northern hemisphere
              ENDIF
              psolaralb(ig,1) = albedice(icap)
@@ -514,11 +552,11 @@
            endif 
           end do
-          PRINT*,'minimum albedo avec givre et co2',
-     s     psolaralb(ISMIN(ngrid,psolaralb,1),1)
-          PRINT*,'maximum albedo avec givre et co2',
-     s     psolaralb(ISMAX(ngrid,psolaralb,1),1)
+          PRINT*,'surfini: minimum albedo with frost and co2',
+     &            minval(albedodat)
+          PRINT*,'surfini: maximum albedo with frost and co2',
+     &            maxval(albedodat)
        ELSE
          watercaptag(:) = .false.
-       END IF
+       END IF ! OF IF(water)
          
       RETURN
Index: trunk/LMDZ.MARS/libf/phymars/tabfi.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/tabfi.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/tabfi.F	(revision 1130)
@@ -48,4 +48,6 @@
      &                     iceradius, dtemisice, iceradius
       use yomaer_h, only: tauvis
+      use iostart, only: get_var
+      use mod_phys_lmdz_para, only: is_parallel
       implicit none
  
@@ -67,12 +69,14 @@
 c Arguments
 c ---------
-      INTEGER nid,nvarid,tab0
-      INTEGER*4 day_ini
-      INTEGER Lmodif
-      INTEGER lmax
-      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec,time,peri_ls
+      INTEGER,INTENT(IN) :: nid,tab0
+      INTEGER*4,INTENT(OUT) :: day_ini
+      INTEGER,INTENT(IN) :: Lmodif
+      INTEGER,INTENT(OUT) :: lmax
+      REAL,INTENT(OUT) :: p_rad,p_omeg,p_g,p_mugaz,p_daysec,time
 
 c Variables
 c ---------
+      INTEGER :: nvarid
+      REAL :: peri_ls
       INTEGER length
       parameter (length = 100)
@@ -81,9 +85,8 @@
       INTEGER size
       CHARACTER modif*20
-
-c Fonctions DRS et autres
-c -----------------------
-      INTEGER setname, cluvdb, getdat
-
+      LOGICAL :: found
+
+      write(*,*)"tabfi: nid=",nid," tab0=",tab0," Lmodif=",Lmodif
+      
 c-----------------------------------------------------------------------
 c  Initialization of various physical constants to defaut values (nid = 0 case)
@@ -150,20 +153,26 @@
 c Read 'controle' array
 c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Tabfi: Could not find <controle> data"
-         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*, "Tabfi: Failed reading <controle> array"
-         CALL abort
-      ENDIF
-
-       print*,'tabfi: tab_cntrl',tab_cntrl
+!      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+!      IF (ierr .NE. NF_NOERR) THEN
+!         PRINT*, "Tabfi: Could not find <controle> data"
+!         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*, "Tabfi: Failed reading <controle> array"
+!         CALL abort
+!      ENDIF
+
+       call get_var("controle",tab_cntrl,found)
+       if (.not.found) then
+         write(*,*)"tabfi: Failed reading <controle> array"
+         call abort
+       else
+         write(*,*)'tabfi: tab_cntrl',tab_cntrl
+       endif
 c
 c  Initialization of some physical constants
@@ -269,4 +278,10 @@
 c-----------------------------------------------------------------------
 c	 Modifications...
+! NB: Modifying controls should only be done by newstart, and in seq mode
+      if ((Lmodif.eq.1).and.is_parallel) then
+        write(*,*) "tabfi: Error modifying tab_control should",
+     &             " only happen in serial mode (eg: by newstart)"
+        stop
+      endif
 c-----------------------------------------------------------------------
 
Index: trunk/LMDZ.MARS/libf/phymars/testphys1d.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/testphys1d.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/testphys1d.F	(revision 1130)
@@ -3,6 +3,6 @@
 ! to use  'getin'
       USE ioipsl_getincom, only: getin
-      use infotrac, only: nqtot, tnom
-      use comsoil_h, only: volcapa, layer, mlayer, inertiedat
+      use infotrac, only: nqtot, tname
+      use comsoil_h, only: volcapa, layer, mlayer, inertiedat, nsoilmx
       use comgeomfi_h, only: lati, long, area
       use comdiurn_h, only: sinlat
@@ -13,4 +13,7 @@
       use slope_mod, only: theta_sl, psi_sl
       use yomaer_h, only: tauvis
+      use control_mod, only: day_step
+      use phyredem, only: physdem0,physdem1
+      use comgeomphy, only: initcomgeomphy
       IMPLICIT NONE
 
@@ -36,4 +39,5 @@
 #include "dimensions.h"
 #include "dimphys.h"
+      integer, parameter :: ngrid = 1 !(2+(jjm-1)*iim - 1/jjm)
 !#include "dimradmars.h"
 !#include "comgeomfi.h"
@@ -47,5 +51,5 @@
 !#include "comsaison.h"
 !#include "yomaer.h"
-#include "control.h"
+!#include "control.h"
 #include "comvert.h"
 #include "netcdf.inc"
@@ -70,5 +74,5 @@
       REAL play(nlayermx)   ! Pressure at the middle of the layers (Pa)
       REAL plev(nlayermx+1) ! intermediate pressure levels (pa)
-      REAL psurf,tsurf      
+      REAL psurf,tsurf(1)      
       REAL u(nlayermx),v(nlayermx)  ! zonal, meridional wind
       REAL gru,grv   ! prescribed "geostrophic" background wind
@@ -77,6 +81,6 @@
       REAL,ALLOCATABLE :: qsurf(:) ! tracer surface budget (e.g. kg.m-2)
       REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
-      REAL co2ice           ! co2ice layer (kg.m-2)
-      REAL emis             ! surface layer
+      REAL co2ice(1)        ! co2ice layer (kg.m-2)
+      REAL emis(1)          ! surface layer
       REAL q2(nlayermx+1)   ! Turbulent Kinetic Energy
       REAL zlay(nlayermx)   ! altitude estimee dans les couches (km)
@@ -111,4 +115,8 @@
 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 ------------------------------------------------------
@@ -203,5 +211,5 @@
         endif
         ! allocate arrays:
-        allocate(tnom(nq))
+        allocate(tname(nq))
         allocate(q(nlayermx,nq))
         allocate(qsurf(nq))
@@ -212,5 +220,5 @@
         ! read tracer names from file traceur.def
         do iq=1,nq
-          read(90,*,iostat=ierr) tnom(iq)
+          read(90,*,iostat=ierr) tname(iq)
           if (ierr.ne.0) then
             write(*,*) 'testphys1d: error reading tracer names...'
@@ -228,5 +236,5 @@
         do iq=1,nq
           txt=""
-          write(txt,"(a)") tnom(iq)
+          write(txt,"(a)") tname(iq)
           write(*,*)"  tracer:",trim(txt)
           ! CO2
@@ -366,5 +374,5 @@
         nq=1
         ! allocate arrays:
-        allocate(tnom(nq))
+        allocate(tname(nq))
         allocate(q(nlayermx,nq))
         allocate(qsurf(nq))
@@ -374,5 +382,5 @@
         do iq=1,nq
           write(str7,'(a1,i2.2)')'q',iq
-          tnom(iq)=str7
+          tname(iq)=str7
         enddo
       ! and just to be clean, also initialize tracers to zero for physdem1
@@ -549,5 +557,5 @@
 c  CO2 ice on the surface
 c  -------------------
-      co2ice=0.E+0 ! default value for co2ice
+      co2ice(1)=0.E+0 ! default value for co2ice
       PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
       call getin("co2ice",co2ice)
@@ -558,5 +566,5 @@
 c  ----------
       emis=emissiv
-      IF (co2ice.eq.1.E+0) THEN
+      IF (co2ice(1).eq.1.E+0) THEN
          emis=emisice(1) ! northern hemisphere
          IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
@@ -615,5 +623,5 @@
       DO isoil=1,nsoil
          inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
-         tsoil(isoil)=tsurf  ! soil temperature
+         tsoil(isoil)=tsurf(1)  ! soil temperature
       ENDDO
 
@@ -817,2 +825,3 @@
 
 #include "../dyn3d/disvert.F"
+#include "../dyn3d/abort_gcm.F"
Index: trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90	(revision 1130)
@@ -43,4 +43,5 @@
 
       USE comtherm_h
+      use planetwide_mod, only: planetwide_maxval
 
       IMPLICIT NONE
@@ -764,5 +765,8 @@
 ! ===========================================================================
 
-      zlmax=MAXVAL(lmax(:))+2
+      !zlmax=MAXVAL(lmax(:))+2 ! OK, but in serial mode only; use planet
+      call planetwide_maxval(lmax,zlmax)
+      zlmax=zlmax+2
+      
       if (zlmax .ge. nlayer) then
         print*,'thermals have reached last layer of the model'
@@ -790,8 +794,9 @@
 
 ! llmax is the index of the heighest thermal in the simulation domain
-      llmax=1
-      do ig=1,ngrid
-         if (lalim(ig)>llmax) llmax=lalim(ig)
-      enddo
+      !llmax=1
+      !do ig=1,ngrid
+      !   if (lalim(ig)>llmax) llmax=lalim(ig)
+      !enddo
+      call planetwide_maxval(lalim,llmax)
 
 ! Integral of a**2/(rho* Delta z), see equation 13 of appendix 4.2 in paper
Index: trunk/LMDZ.MARS/libf/phymars/vdif_kc.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/vdif_kc.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/vdif_kc.F	(revision 1130)
@@ -32,15 +32,15 @@
 c 
 c.......................................................................
-      REAL dt,g
-      REAL zlev(ngrid,nlay+1)
-      REAL zlay(ngrid,nlay)
-      REAL u(ngrid,nlay)
-      REAL v(ngrid,nlay)
-      REAL teta(ngrid,nlay)
-      REAL cd(ngrid)
-      REAL q2(ngrid,nlay+1)
-      REAL km(ngrid,nlay+1)
-      REAL kn(ngrid,nlay+1)
-      REAL zq(ngrid,nlay,nq)
+      REAL,INTENT(IN) :: dt,g
+      REAL,INTENT(IN) :: zlev(ngrid,nlay+1)
+      REAL,INTENT(IN) :: zlay(ngrid,nlay)
+      REAL,INTENT(IN) :: u(ngrid,nlay)
+      REAL,INTENT(IN) :: v(ngrid,nlay)
+      REAL,INTENT(IN) :: teta(ngrid,nlay)
+      REAL,INTENT(IN) :: cd(ngrid)
+      REAL,INTENT(INOUT) :: q2(ngrid,nlay+1)
+      REAL,INTENT(OUT) :: km(ngrid,nlay+1)
+      REAL,INTENT(OUT) :: kn(ngrid,nlay+1)
+      REAL,INTENT(IN) :: zq(ngrid,nlay,nq)
 c.......................................................................
 c
@@ -247,4 +247,11 @@
       nlev=nlay+1
       
+      ! Other initializations of local variables (to be clean)
+      long(:,:)=0.
+      n2(:,:)=0.
+      sn(:,:)=0.
+      snq2(:,:)=0.
+      sm(:,:)=0.
+      smq2(:,:)=0.
 c.......................................................................
 c  Special treatment for co2
@@ -381,6 +388,6 @@
         gninf=.false.
         gnsup=.false.
-        long(igrid,ilev)=long(igrid,ilev)
-        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev) ! not very useful...
+        long(igrid,ilev)=long(igrid,ilev) ! not very useful...
 c
         IF (gn.lt.gnmin) THEN
@@ -609,4 +616,18 @@
 c.......................................................................
 c
+
+!        call writediagfi(ngrid,'vdif_kc_q2','','',3,q2(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_km','','',3,km(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_kn','','',3,kn(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_unsdz','','',3,unsdz(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_unsddecz','','',3,
+!     &                   unsdzdec(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_q','','',3,q(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_kmpre','','',3,
+!     &                   kmpre(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_long','','',3,long(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_sn','','',3,sn(:,1:nlay))
+!        call writediagfi(ngrid,'vdif_kc_sm','','',3,sm(:,1:nlay))
+
       RETURN
       END
Index: trunk/LMDZ.MARS/libf/phymars/vdifc.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/vdifc.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/vdifc.F	(revision 1130)
@@ -56,5 +56,4 @@
       REAL,INTENT(IN) :: pu(ngrid,nlay),pv(ngrid,nlay)
       REAL,INTENT(IN) :: ph(ngrid,nlay)
-      REAL :: pt(ngrid,nlay)
       REAL,INTENT(IN) :: ptsrf(ngrid),pemis(ngrid)
       REAL,INTENT(IN) :: pdufi(ngrid,nlay),pdvfi(ngrid,nlay)
@@ -63,6 +62,6 @@
       REAL,INTENT(OUT) :: pdudif(ngrid,nlay),pdvdif(ngrid,nlay)
       REAL,INTENT(OUT) :: pdtsrf(ngrid),pdhdif(ngrid,nlay)
-      REAL,INTENT(IN) ::pcapcal(ngrid)
-      REAL pq2(ngrid,nlay+1)
+      REAL,INTENT(IN) :: pcapcal(ngrid)
+      REAL,INTENT(INOUT) :: pq2(ngrid,nlay+1)
 
 c    Argument added for condensation:
@@ -86,4 +85,5 @@
 c   ------
 
+      REAL :: pt(ngrid,nlay)
       REAL ust(ngrid),tst(ngrid)
  
@@ -363,18 +363,18 @@
 ! Some usefull diagnostics for the new surface layer parametrization :
 
-!        call WRITEDIAGFI(ngrid,'pcdv',
+!        call WRITEDIAGFI(ngrid,'vdifc_zcdv_true',
 !     &              'momentum drag','no units',
 !     &                         2,zcdv_true)
-!        call WRITEDIAGFI(ngrid,'pcdh',
+!        call WRITEDIAGFI(ngrid,'vdifc_zcdh_true',
 !     &              'heat drag','no units',
 !     &                         2,zcdh_true)
-!        call WRITEDIAGFI(ngrid,'ust',
+!        call WRITEDIAGFI(ngrid,'vdifc_ust',
 !     &              'friction velocity','m/s',2,ust)
-!       call WRITEDIAGFI(ngrid,'tst',
+!       call WRITEDIAGFI(ngrid,'vdifc_tst',
 !     &              'friction temperature','K',2,tst)
-!        call WRITEDIAGFI(ngrid,'rm-1',
+!        call WRITEDIAGFI(ngrid,'vdifc_zcdv',
 !     &              'aerodyn momentum conductance','m/s',
 !     &                         2,zcdv)
-!        call WRITEDIAGFI(ngrid,'rh-1',
+!        call WRITEDIAGFI(ngrid,'vdifc_zcdh',
 !     &              'aerodyn heat conductance','m/s',
 !     &                         2,zcdh)
@@ -384,5 +384,5 @@
        IF (.not. calltherm) THEN
 
-       CALL vdif_kc(ptimestep,g,pzlev,pzlay
+       CALL vdif_kc(ngrid,nlay,nq,ptimestep,g,pzlev,pzlay
      &              ,pu,pv,ph,zcdv_true
      &              ,pq2,zkv,zkh,zq)
Index: trunk/LMDZ.MARS/libf/phymars/writediagfi.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/writediagfi.F	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/writediagfi.F	(revision 1130)
@@ -40,4 +40,8 @@
 !=================================================================
       use surfdat_h, only: phisfi
+      use control_mod, only: ecritphy, day_step, iphysiq
+      USE mod_phys_lmdz_para, only : is_parallel, is_mpi_root,
+     &                               is_master, gather
+      USE mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
       implicit none
 
@@ -46,5 +50,5 @@
 !#include "dimphys.h"
 #include "paramet.h"
-#include "control.h"
+!#include "control.h"
 #include "comvert.h"
 #include "comgeom.h"
@@ -97,4 +101,19 @@
       
 #ifndef MESOSCALE
+
+#ifdef CPP_PARA
+! Added to work in parallel mode
+      real dx3_glop(klon_glo,llm)
+      real dx3_glo(iim,jjp1,llm) ! to store a global 3D data set
+      real dx2_glop(klon_glo)
+      real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
+      real px2(ngrid)
+!      real dx1_glo(llm)          ! to store a 1D (column) data set
+!      real dx0_glo
+      real phisfi_glo(klon_glo) ! surface geopotential on global physics grid
+#else
+      real phisfi_glo(ngrid) ! surface geopotential on global physics grid
+#endif
+
 !***************************************************************
 !Sortie des variables au rythme voulu
@@ -162,7 +181,21 @@
            stop
          endif
+         
+         zitau = -1 ! initialize zitau
+
+#ifdef CPP_PARA
+          ! Gather phisfi() geopotential on physics grid
+          call Gather(phisfi,phisfi_glo)
+#else
+         phisfi_glo(:)=phisfi(:)
+#endif
+
+         !! parallel: we cannot use the usual writediagfi method
+!!         call iophys_ini
+         if (is_master) then
+         ! only the master is required to do this
 
          ! Create the NetCDF file
-         ierr = NF_CREATE(fichnom, IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
+         ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
          ! Define the 'Time' dimension
          ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
@@ -183,11 +216,18 @@
 
          ! write "header" of file (longitudes, latitudes, geopotential, ...)
-         call gr_fi_dyn(1,ngrid,iip1,jjp1,phisfi,phis)
+         call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
          call iniwrite(nid,day_ini,phis)
-         
-         zitau = -1 ! initialize zitau
+
+         endif ! of if (is_master)
+
       else
-         ! Open the NetCDF file
-         ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+
+         if (is_master) then
+           ! only the master is required to do this
+
+           ! Open the NetCDF file
+           ierr = NF_OPEN(fichnom,NF_WRITE,nid)
+         endif ! of if (is_master)
+
       endif ! if (firstnom.eq.'1234567890')
 
@@ -218,4 +258,6 @@
 !--------------------------------------------------------
 
+        if (is_master) then
+           ! only the master is required to do this
         if (nom.eq.firstnom) then
         ! We have identified a "first call" (at given date)
@@ -241,8 +283,23 @@
         end if ! of if (nom.eq.firstnom)
 
+        endif ! of if (is_master)
+
 !Case of a 3D variable
 !---------------------
         if (dim.eq.3) then
 
+#ifdef CPP_PARA
+          ! Gather field on a "global" (without redundant longitude) array
+          call Gather(px,dx3_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+            ! copy dx3_glo() to dx3(:) and add redundant longitude
+            dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+            dx3(iip1,:,:)=dx3(1,:,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
 !         Passage variable physique -->  variable dynamique
 !         recast (copy) variable from physics grid to dynamics grid
@@ -260,9 +317,9 @@
              ENDDO
            ENDDO
-
+#endif
 !         Ecriture du champs
 
-!         write (*,*) 'In  writediagfi, on sauve:  ' , nom
-!         write (*,*) 'In  writediagfi. Estimated date = ' ,date
+          if (is_master) then
+           ! only the master writes to output
 ! name of the variable
            ierr= NF_INQ_VARID(nid,nom,varid)
@@ -294,4 +351,8 @@
 !           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
 !#else
+!           write(*,*)"test:  nid=",nid," varid=",varid
+!           write(*,*)"       corner()=",corner
+!           write(*,*)"       edges()=",edges
+!           write(*,*)"       dx3()=",dx3
            ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
 !#endif
@@ -300,12 +361,29 @@
               write(*,*) "***** PUT_VAR problem in writediagfi"
               write(*,*) "***** with ",nom
-              write(*,*) 'ierr=', ierr
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
 c             call abort
            endif 
 
+          endif !of if (is_master)
+
 !Case of a 2D variable
 !---------------------
 
         else if (dim.eq.2) then
+
+#ifdef CPP_PARA
+          ! Gather field on a "global" (without redundant longitude) array
+          px2(:)=px(:,1)
+          call Gather(px2,dx2_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(dx2_glop,dx2_glo)
+            ! copy dx2_glo() to dx2(:) and add redundant longitude
+            dx2(1:iim,:)=dx2_glo(1:iim,:)
+            dx2(iip1,:)=dx2(1,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
 
 !         Passage variable physique -->  physique dynamique
@@ -323,5 +401,8 @@
                 dx2(iip1,j)=dx2(1,j)
              ENDDO
-
+#endif
+
+          if (is_master) then
+           ! only the master writes to output
 !         write (*,*) 'In  writediagfi, on sauve:  ' , nom
 !         write (*,*) 'In  writediagfi. Estimated date = ' ,date
@@ -359,12 +440,19 @@
               write(*,*) "***** PUT_VAR matter in writediagfi"
               write(*,*) "***** with ",nom
-              write(*,*) 'ierr=', ierr
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
 c             call abort
            endif 
 
+          endif !of if (is_master)
+
 !Case of a 1D variable (ie: a column)
 !---------------------------------------------------
 
        else if (dim.eq.1) then
+         if (is_parallel) then
+           write(*,*) "writediagfi error: dim=1 not implemented ",
+     &                 "in parallel mode"
+           stop
+         endif
 !         Passage variable physique -->  physique dynamique
 !         recast (copy) variable from physics grid to dynamics grid
@@ -402,5 +490,5 @@
               write(*,*) "***** PUT_VAR problem in writediagfi"
               write(*,*) "***** with ",nom
-              write(*,*) 'ierr=', ierr
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
 c             call abort
            endif 
@@ -410,6 +498,9 @@
 
         else if (dim.eq.0) then
+
            dx0 = px (1,1)
 
+          if (is_master) then
+           ! only the master writes to output
            ierr= NF_INQ_VARID(nid,nom,varid)
            if (ierr /= NF_NOERR) then
@@ -437,13 +528,17 @@
               write(*,*) "***** PUT_VAR matter in writediagfi"
               write(*,*) "***** with ",nom
-              write(*,*) 'ierr=', ierr
+              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
 c             call abort
            endif 
 
+          endif !of if (is_master)
+
         endif ! of if (dim.eq.3) elseif(dim.eq.2)...
 
       endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
 
-      ierr= NF_CLOSE(nid)
+      if (is_master) then
+        ierr= NF_CLOSE(nid)
+      endif
 
 #endif
Index: trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90	(revision 1130)
@@ -13,4 +13,7 @@
 
 use comsoil_h, only: nsoilmx
+use control_mod, only: ecritphy, day_step, iphysiq
+use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
+use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
 
 implicit none
@@ -19,5 +22,5 @@
 !#include"dimphys.h"
 #include"paramet.h"
-#include"control.h"
+!#include"control.h"
 !#include"comsoil.h"
 #include"netcdf.inc"
@@ -56,4 +59,13 @@
 integer,dimension(4) :: edges,corners
 
+#ifdef CPP_PARA
+! Added to work in parallel mode
+real dx3_glop(klon_glo,nsoilmx)
+real dx3_glo(iim,jjp1,nsoilmx) ! to store a global 3D data set
+real dx2_glop(klon_glo)
+real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
+real px2(ngrid)
+#endif
+
 ! 1. Initialization step
 if (firstname.eq."1234567890") then
@@ -75,10 +87,12 @@
   
   ! Create output NetCDF file
-  ierr=NF_CREATE(filename,IOR(NF_CLOBBER,NF_64BIT_OFFSET),nid)
-  if (ierr.ne.NF_NOERR) then
+  if (is_master) then
+   ierr=NF_CREATE(filename,NF_CLOBBER,nid)
+   if (ierr.ne.NF_NOERR) then
     write(*,*)'writediagsoil: Error, failed creating file '//trim(filename)
     stop
-  endif
-  
+   endif
+  endif ! of if (is_master)
+
   ! Define dimensions and axis attributes
   call iniwritesoil(nid,ngrid)
@@ -89,5 +103,7 @@
 else
   ! If not an initialization call, simply open the NetCDF file
-  ierr=NF_OPEN(filename,NF_WRITE,nid)
+  if (is_master) then
+   ierr=NF_OPEN(filename,NF_WRITE,nid)
+  endif
 endif ! of if (firstname.eq."1234567890")
 
@@ -105,19 +121,21 @@
   if (name.eq.firstname) then
     ntime=ntime+1
-    date=real(zitau+1)/real(day_step)
+    date=float(zitau+1)/float(day_step)
     ! Note: day_step is known from control.h
     
-    ! Get NetCDF ID for "time"
-    ierr=NF_INQ_VARID(nid,"time",varid)
-    ! Add the current value of date to the "time" array
+    if (is_master) then
+     ! Get NetCDF ID for "time"
+     ierr=NF_INQ_VARID(nid,"time",varid)
+     ! Add the current value of date to the "time" array
 !#ifdef NC_DOUBLE
-!    ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+!     ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
 !#else
-    ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+     ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
 !#endif
-    if (ierr.ne.NF_NOERR) then
+     if (ierr.ne.NF_NOERR) then
       write(*,*)"writediagsoil: Failed writing date to time variable"
       stop 
-    endif
+     endif
+    endif ! of if (is_master)
   endif ! of if (name.eq.firstname)
 
@@ -125,4 +143,17 @@
 if (dimpx.eq.3) then ! Case of a 3D variable
   ! A. Recast data along 'dynamics' grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+  call Gather(px,dx3_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(dx3_glop,dx3_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    data3(1:iim,:,:)=dx3_glo(1:iim,:,:)
+    data3(iip1,:,:)=data3(1,:,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
   do l=1,nsoilmx
     ! handle the poles
@@ -140,6 +171,8 @@
     enddo
   enddo
+#endif
   
   ! B. Write (append) the variable to the NetCDF file
+  if (is_master) then
   ! B.1. Get the ID of the variable
   ierr=NF_INQ_VARID(nid,name,varid)
@@ -179,7 +212,23 @@
                " to file "//trim(filename)//" at time",date
   endif
+  endif ! of if (is_master)
 
 elseif (dimpx.eq.2) then ! Case of a 2D variable
+
   ! A. Recast data along 'dynamics' grid
+#ifdef CPP_PARA
+  ! gather field on a "global" (without redundant longitude) array
+  px2(:)=px(:,1)
+  call Gather(px2,dx2_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(dx2_glop,dx2_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    data2(1:iim,:)=dx2_glo(1:iim,:)
+    data2(iip1,:)=data2(1,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+#else
   ! handle the poles
   do i=1,iip1
@@ -195,6 +244,8 @@
     data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
   enddo
+#endif
 
   ! B. Write (append) the variable to the NetCDF file
+  if (is_master) then
   ! B.1. Get the ID of the variable
   ierr=NF_INQ_VARID(nid,name,varid)
@@ -231,6 +282,11 @@
                " to file "//trim(filename)//" at time",date
   endif
+  endif ! of if (is_master)
 
 elseif (dimpx.eq.0) then ! Case of a 0D variable
+#ifdef CPP_PARA
+  write(*,*) "writediagsoil: dimps==0 case not implemented in // mode!!"
+  stop
+#endif
   ! A. Copy data value
   data0=px(1,1)
@@ -270,5 +326,7 @@
 
 ! 4. Close the NetCDF file
-ierr=NF_CLOSE(nid)
+if (is_master) then
+  ierr=NF_CLOSE(nid)
+endif
 
 end subroutine writediagsoil
Index: trunk/LMDZ.MARS/libf/phymars/wstats.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/wstats.F90	(revision 1127)
+++ trunk/LMDZ.MARS/libf/phymars/wstats.F90	(revision 1130)
@@ -1,3 +1,6 @@
 subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather, klon_mpi_begin
+use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
 
 implicit none
@@ -5,4 +8,5 @@
 #include "dimensions.h"
 #include "dimphys.h"
+#include "comconst.h"
 #include "statto.h"
 #include "netcdf.inc"
@@ -11,95 +15,130 @@
 character (len=*),intent(in) :: nom,titre,unite
 integer,intent(in) :: dim
-real, dimension(ngrid,llm),intent(in) :: px
 integer,parameter :: iip1=iim+1
 integer,parameter :: jjp1=jjm+1
+real,intent(in) :: px(ngrid,llm)
 real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
 real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
 character (len=50) :: namebis
 character (len=50), save :: firstvar
-integer :: ierr,ierr2,varid,nbdim,nid
+integer :: ierr,varid,nbdim,nid
 integer :: meanid,sdid
-integer, dimension(4)  :: id,start,size
+integer, dimension(4)  :: id,start,sizes
 logical, save :: firstcall=.TRUE.
 integer :: l,i,j,ig0
-integer,save :: index
-! Added to use stats.def to select output variable
-logical,save :: stats_def
-logical :: getout
-integer,save :: n_nom_def
-integer :: n
-integer,parameter :: n_nom_def_max=99
-character(len=20),save :: nom_def(n_nom_def_max)
-logical, save :: notfoundfirst=.TRUE.
+integer,save :: indx
 
 integer, save :: step=0
-      
-      
-
+
+! Added to work in parallel mode
+#ifdef CPP_PARA
+real px3_glop(klon_glo,llm) ! to store a 3D data set on global physics grid
+real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
+real px2_glop(klon_glo) ! to store a 2D data set on global physics grid
+real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
+real px2(ngrid)
+real px3(ngrid,llm)
+#else
+! When not running in parallel mode:
+real px3_glop(ngrid,llm) ! to store a 3D data set on global physics grid
+real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
+real px2_glop(ngrid) ! to store a 2D data set on global physics grid
+real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
+#endif
+
+! 1. Initialization (creation of stats.nc file)
 if (firstcall) then
    firstcall=.false.
+   firstvar=trim((nom))
    call inistats(ierr)
-! at very first call, check if there is a "stats.def" to use and read it
-   open(99,file="stats.def",status='old',form='formatted',iostat=ierr2)
-   if(ierr2.eq.0) then
-     stats_def=.true.
-     write(*,*) "******************"
-     write(*,*) "Reading stats.def"
-     write(*,*) "******************"
-     do n=1,n_nom_def_max
-          read(99,fmt='(a)',end=88) nom_def(n)
-          write(*,*) 'Output in stats: ', trim(nom_def(n))
-     end do 
-88   continue
-     if (n.ge.n_nom_def_max) then
-        write(*,*)"n_nom_def_max too small in wstats.F90:",n
-        stop
-     end if 
-     n_nom_def=n-1
-     close(99)
-   else
-     firstvar=trim((nom))
-     stats_def=.false.
-     notfoundfirst=.false.
-   endif
-endif
-
-! find firstvar that is in stats.def
-if (notfoundfirst) then
-   do n=1,n_nom_def_max
-     if(trim((nom_def(n))).eq.trim((nom))) then
-        firstvar=trim((nom))
-        notfoundfirst=.false.
-     endif
-   end do 
-endif
-
-! get out of wstats if there is stats.def AND variable not listed
-if (stats_def) then
-   getout=.true.
-   do n=1,n_nom_def
-       if(trim(nom_def(n)).eq.nom) getout=.false.
-   end do
-   if (getout) return
-end if
-
-if (firstvar==nom) then ! If we're back to the first variable
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable, increment time counter
       step = step + 1
 endif
 
 if (mod(step,istats).ne.0) then
+  ! if its not time to write to file, exit
    RETURN
 endif
 
+! collect fields on a global physics grid
+#ifdef CPP_PARA
+ if (dim.eq.3) then
+  px3(1:ngrid,1:llm)=px(1:ngrid,1:llm)
+  ! Gather fieds on a "global" (without redundant longitude) array
+  call Gather(px3,px3_glop)
+!$OMP MASTER
+  if (is_mpi_root) then
+    call Grid1Dto2D_glo(px3_glop,px3_glo)
+    ! copy dx3_glo() to dx3(:) and add redundant longitude
+    dx3(1:iim,:,:)=px3_glo(1:iim,:,:)
+    dx3(iip1,:,:)=dx3(1,:,:)
+  endif
+!$OMP END MASTER
+!$OMP BARRIER
+ else ! dim.eq.2
+  ! Gather fieds on a "global" (without redundant longitude) array
+  px2(:)=px(:,1)
+  call Gather(px2,px2_glop)
+!$OMP MASTER
+          if (is_mpi_root) then
+            call Grid1Dto2D_glo(px2_glop,px2_glo)
+            ! copy px2_glo() to dx2(:) and add redundant longitude
+            dx2(1:iim,:)=px2_glo(1:iim,:)
+            dx2(iip1,:)=dx2(1,:)
+          endif
+!$OMP END MASTER
+!$OMP BARRIER
+ endif
+#else
+  if (dim.eq.3) then
+    px3_glop(:,1:llm)=px(:,1:llm)
+!  Passage variable physique -->  variable dynamique
+    DO l=1,llm
+      DO i=1,iim
+         px3_glo(i,1,l)=px(1,l)
+         px3_glo(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            px3_glo(i,j,l)=px(ig0+i,l)
+         ENDDO
+      ENDDO
+    ENDDO
+  else ! dim.eq.2
+    px2_glop(:)=px(:,1)
+!    Passage variable physique -->  physique dynamique
+   DO i=1,iim
+     px2_glo(i,1)=px(1,1)
+     px2_glo(i,jjp1)=px(ngrid,1)
+   ENDDO
+   DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        px2_glo(i,j)=px(ig0+i,1)
+     ENDDO
+   ENDDO
+  endif
+#endif
+
+! 2. Write field to file
+
+if (is_master) then
+! only master needs do this
+
 ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
 
 namebis=trim(nom)
+
+! test: check if that variable already exists in file
 ierr= NF_INQ_VARID(nid,namebis,meanid)
 
 if (ierr.ne.NF_NOERR) then
-
+  ! variable not in file, create/define it
    if (firstvar==nom) then 
-      index=1
-      count=0
+      indx=1
+      count(:)=0
    endif
 
@@ -122,9 +161,17 @@
    write (*,*) "STATS: creation de ",nom
    namebis=trim(nom)
-   call def_var_stats(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
-   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   if (dim.eq.3) then
+     call inivar(nid,meanid,size(px3_glop,1),dim,indx,px3_glop,ierr)
+   else ! dim.eq.2
+     call inivar(nid,meanid,size(px2_glop,1),dim,indx,px2_glop,ierr)
+   endif
    namebis=trim(nom)//"_sd"
-   call def_var_stats(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
-   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   if (dim.eq.3) then
+     call inivar(nid,sdid,size(px3_glop,1),dim,indx,px3_glop,ierr)
+   else ! dim.eq.2
+     call inivar(nid,sdid,size(px2_glop,1),dim,indx,px2_glop,ierr)
+   endif
 
    ierr= NF_CLOSE(nid)
@@ -132,4 +179,5 @@
 
 else
+   ! variable found in file
    namebis=trim(nom)//"_sd"
    ierr= NF_INQ_VARID(nid,namebis,sdid)
@@ -138,33 +186,35 @@
 
 if (firstvar==nom) then 
-   count(index)=count(int(index))+1
-   index=index+1
-   if (index>istime) then
-      index=1
-   endif
-endif
-
-if (count(index)==0) then
+   count(indx)=count(int(indx))+1
+   indx=indx+1
+   if (indx>istime) then
+      indx=1
+   endif
+endif
+
+if (count(indx)==0) then
+   ! very first time we write the variable to file
    if (dim.eq.3) then
-      start=(/1,1,1,index/)
-      size=(/iip1,jjp1,llm,1/)
-      mean3d=0
-      sd3d=0
+      start=(/1,1,1,indx/)
+      sizes=(/iip1,jjp1,llm,1/)
+      mean3d(:,:,:)=0
+      sd3d(:,:,:)=0
    else if (dim.eq.2) then
-      start=(/1,1,index,0/)
-      size=(/iip1,jjp1,1,0/)
-      mean2d=0
-      sd2d=0
+      start=(/1,1,indx,0/)
+      sizes=(/iip1,jjp1,1,0/)
+      mean2d(:,:)=0
+      sd2d(:,:)=0
    endif
 else
+   ! load values from file
    if (dim.eq.3) then
-      start=(/1,1,1,index/)
-      size=(/iip1,jjp1,llm,1/)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
-      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
-#else
-      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
-      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+      start=(/1,1,1,indx/)
+      sizes=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,sizes,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,sizes,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,sizes,sd3d)
 #endif
       if (ierr.ne.NF_NOERR) then
@@ -174,12 +224,12 @@
 
    else if (dim.eq.2) then
-      start=(/1,1,index,0/)
-      size=(/iip1,jjp1,1,0/)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
-      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
-#else
-      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
-      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+      start=(/1,1,indx,0/)
+      sizes=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,sizes,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,sizes,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,sizes,sd2d)
 #endif
       if (ierr.ne.NF_NOERR) then
@@ -188,7 +238,78 @@
       endif
    endif
-endif
+endif ! of if (count(indx)==0)
+
+
+! 2.1. Build dx* (data on lon-lat grid, with redundant longitude)
 
 if (dim.eq.3) then
+  dx3(1:iim,:,:)=px3_glo(:,:,:)
+  dx3(iip1,:,:)=dx3(1,:,:)
+else ! dim.eq.2
+  dx2(1:iim,:)=px2_glo(:,:)
+  dx2(iip1,:)=dx2(1,:)
+endif
+
+
+! 2.2. Add current values to previously stored sums
+
+if (dim.eq.3) then
+
+   mean3d(:,:,:)=mean3d(:,:,:)+dx3(:,:,:)
+   sd3d(:,:,:)=sd3d(:,:,:)+dx3(:,:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,sizes,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,sizes,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd3d)
+#endif
+
+else if (dim.eq.2) then
+
+   mean2d(:,:)= mean2d(:,:)+dx2(:,:)
+   sd2d(:,:)=sd2d(:,:)+dx2(:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,sizes,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,sizes,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd2d)
+#endif
+
+endif ! of if (dim.eq.3) elseif (dim.eq.2)
+
+  ierr= NF_CLOSE(nid)
+endif ! of if (is_master)
+
+end subroutine wstats
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,indx,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,indx,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,sizes
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,indx/)
+   sizes=(/iip1,jjp1,llm,1/)
 
 !  Passage variable physique -->  variable dynamique
@@ -208,20 +329,14 @@
    ENDDO
 
-   mean3d(:,:,:)= mean3d(:,:,:)+dx3(:,:,:)
-   sd3d(:,:,:)= sd3d(:,:,:)+dx3(:,:,:)**2
-
-#ifdef NC_DOUBLE
-   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
-   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
-#else
-   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
-   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
-#endif
-   if (ierr.ne.NF_NOERR) then
-     write (*,*) NF_STRERROR(ierr)
-     stop ""
-   endif
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx3)
+#endif
 
 else if (dim.eq.2) then
+
+      start=(/1,1,indx,0/)
+      sizes=(/iip1,jjp1,1,0/)
 
 !    Passage variable physique -->  physique dynamique
@@ -239,96 +354,8 @@
   ENDDO
 
-   mean2d(:,:)= mean2d(:,:)+dx2(:,:)
-   sd2d(:,:)= sd2d(:,:)+dx2(:,:)**2
-
-#ifdef NC_DOUBLE
-   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
-   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
-#else
-   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
-   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
-#endif
-   if (ierr.ne.NF_NOERR) then
-     write (*,*) NF_STRERROR(ierr)
-     stop ""
-   endif
-
-endif
-
-ierr= NF_CLOSE(nid)
-
-end subroutine wstats
-
-!======================================================
-subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
-
-implicit none
-
-include "dimensions.h"
-include "dimphys.h"
-include "netcdf.inc"
-
-integer, intent(in) :: nid,varid,dim,index,ngrid
-real, dimension(ngrid,llm), intent(in) :: px
-integer, intent(out) :: ierr
-
-integer,parameter :: iip1=iim+1
-integer,parameter :: jjp1=jjm+1
-
-integer :: l,i,j,ig0
-integer, dimension(4) :: start,size
-real, dimension(iip1,jjp1,llm) :: dx3
-real, dimension(iip1,jjp1) :: dx2
-
-if (dim.eq.3) then
-
-   start=(/1,1,1,index/)
-   size=(/iip1,jjp1,llm,1/)
-
-!  Passage variable physique -->  variable dynamique
-
-   DO l=1,llm
-      DO i=1,iip1
-         dx3(i,1,l)=px(1,l)
-         dx3(i,jjp1,l)=px(ngrid,l)
-      ENDDO
-      DO j=2,jjm
-         ig0= 1+(j-2)*iim
-         DO i=1,iim
-            dx3(i,j,l)=px(ig0+i,l)
-         ENDDO
-         dx3(iip1,j,l)=dx3(1,j,l)
-      ENDDO
-   ENDDO
-
-#ifdef NC_DOUBLE
-   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
-#else
-   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
-#endif
-
-else if (dim.eq.2) then
-
-      start=(/1,1,index,0/)
-      size=(/iip1,jjp1,1,0/)
-
-!    Passage variable physique -->  physique dynamique
-
-  DO i=1,iip1
-     dx2(i,1)=px(1,1)
-     dx2(i,jjp1)=px(ngrid,1)
-  ENDDO
-  DO j=2,jjm
-     ig0= 1+(j-2)*iim
-     DO i=1,iim
-        dx2(i,j)=px(ig0+i,1)
-     ENDDO
-     dx2(iip1,j)=dx2(1,j)
-  ENDDO
-
-#ifdef NC_DOUBLE
-   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
-#else
-   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx2)
 #endif
 
Index: trunk/LMDZ.MARS/libf/phymars/xvik.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/xvik.F	(revision 1130)
+++ trunk/LMDZ.MARS/libf/phymars/xvik.F	(revision 1130)
@@ -0,0 +1,546 @@
+      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
