Index: trunk/LMDZ.MARS/libf/dyn3d/calfis.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/calfis.F	(revision 1399)
+++ 	(revision )
@@ -1,554 +1,0 @@
-      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
-     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
-     $            pducov,pdvcov,pdteta,pdq,pw,
-     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
-c
-c    Auteur :  P. Le Van, F. Hourdin 
-c   .........
-
-      IMPLICIT NONE
-c=======================================================================
-c
-c   1. rearrangement des tableaux et transformation
-c      variables dynamiques  >  variables physiques
-c   2. calcul des termes physiques
-c   3. retransformation des tendances physiques en tendances dynamiques
-c
-c   remarques:
-c   ----------
-c
-c    - les vents sont donnes dans la physique par leurs composantes 
-c      naturelles.
-c    - la variable thermodynamique de la physique est une variable
-c      intensive :   T 
-c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
-c    - les deux seules variables dependant de la geometrie necessaires
-c      pour la physique sont la latitude pour le rayonnement et 
-c      l'aire de la maille quand on veut integrer une grandeur 
-c      horizontalement.
-c    - les points de la physique sont les points scalaires de la 
-c      la dynamique; numerotation:
-c          1 pour le pole nord
-c          (jjm-1)*iim pour l'interieur du domaine
-c          ngridmx pour le pole sud
-c      ---> ngridmx=2+(jjm-1)*iim
-c
-c     Input :
-c     -------
-c       ecritphy        frequence d'ecriture (en jours)de histphy
-c       pucov           covariant zonal velocity
-c       pvcov           covariant meridional velocity 
-c       pteta           potential temperature
-c       pps             surface pressure
-c       pmasse          masse d'air dans chaque maille
-c       pts             surface temperature  (K)
-c       pw              flux vertical (kg/s)
-c
-c    Output :
-c    --------
-c        pdufi          tendency for the natural zonal velocity (ms-1)
-c        pdvfi          tendency for the natural meridional velocity 
-c        pdhfi          tendency for the potential temperature
-c        pdtsfi         tendency for the surface temperature
-c
-c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-
-      INTEGER ngridmx,nq
-      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
-
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-!#include "control.h"
-
-c    Arguments :
-c    -----------
-      LOGICAL  lafin
-      REAL heure
-
-      REAL pvcov(iip1,jjm,llm)
-      REAL pucov(iip1,jjp1,llm)
-      REAL pteta(iip1,jjp1,llm)
-      REAL pmasse(iip1,jjp1,llm)
-      REAL pq(iip1,jjp1,llm,nq)
-      REAL pphis(iip1,jjp1)
-      REAL pphi(iip1,jjp1,llm)
-c
-      REAL pdvcov(iip1,jjm,llm)
-      REAL pducov(iip1,jjp1,llm)
-      REAL pdteta(iip1,jjp1,llm)
-      REAL pdq(iip1,jjp1,llm,nq)
-c
-      REAL pw(iip1,jjp1,llm)
-c
-      REAL pps(iip1,jjp1)
-      REAL pp(iip1,jjp1,llmp1)
-      REAL ppk(iip1,jjp1,llm)
-c
-      REAL pdvfi(iip1,jjm,llm)
-      REAL pdufi(iip1,jjp1,llm)
-      REAL pdhfi(iip1,jjp1,llm)
-      REAL pdqfi(iip1,jjp1,llm,nq)
-      REAL pdpsfi(iip1,jjp1)
-      logical tracer
-
-c    Local variables :
-c    -----------------
-
-      INTEGER i,j,l,ig0,ig,iq
-      REAL zpsrf(ngridmx)
-      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
-      REAL zphi(ngridmx,llm),zphis(ngridmx)
-c
-      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
-      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nq)
-c
-      REAL zvervel(ngridmx,llm)
-c
-      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
-      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nq)
-      REAL zdpsrf(ngridmx)
-c
-      REAL zsin(iim),zcos(iim),z1(iim)
-      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
-      REAL unskap, pksurcp
-c
-      
-      EXTERNAL gr_dyn_fi,gr_fi_dyn
-      EXTERNAL physiq,multipl
-      REAL SSUM
-      EXTERNAL SSUM
-
-      REAL latfi(ngridmx),lonfi(ngridmx)
-      REAL airefi(ngridmx)
-      SAVE latfi, lonfi, airefi
-
-      LOGICAL firstcal, debut
-      DATA firstcal/.true./
-      SAVE firstcal,debut
-      REAL rdayvrai,rday_ecri
-c
-c-----------------------------------------------------------------------
-c
-c    1. Initialisations :
-c    --------------------
-c
-
-
-      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         PRINT*,'STOP dans calfis'
-         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         PRINT*,'  ngridmx  jjm   iim   '
-         PRINT*,ngridmx,jjm,iim
-         STOP
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   latitude, longitude et aires des mailles pour la physique:
-c   ----------------------------------------------------------
-
-c
-      IF ( firstcal )  THEN
-          debut = .TRUE.
-      ELSE
-          debut = .FALSE.
-      ENDIF
-
-c
-!      IF (firstcal) THEN
-!         latfi(1)=rlatu(1)
-!         lonfi(1)=0.
-!         DO j=2,jjm
-!            DO i=1,iim
-!               latfi((j-2)*iim+1+i)= rlatu(j)
-!               lonfi((j-2)*iim+1+i)= rlonv(i)
-!            ENDDO
-!         ENDDO
-!         latfi(ngridmx)= rlatu(jjp1)
-!         lonfi(ngridmx)= 0.
-!         
-!         ! build airefi(), mesh area on physics grid
-!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-!         ! Poles are single points on physics grid
-!         airefi(1)=airefi(1)*iim
-!         airefi(ngridmx)=airefi(ngridmx)*iim
-!
-!         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
-!     .                latfi,lonfi,airefi,rad,g,r,cpp)
-!      ENDIF
-
-c
-c-----------------------------------------------------------------------
-c   40. transformation des variables dynamiques en variables physiques:
-c   ---------------------------------------------------------------
-
-c   41. pressions au sol (en Pascals)
-c   ----------------------------------
-
-       
-      zpsrf(1) = pps(1,1)
-
-      ig0  = 2
-      DO j = 2,jjm
-         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
-         ig0 = ig0+iim
-      ENDDO
-
-      zpsrf(ngridmx) = pps(1,jjp1)
-
-
-c   42. pression intercouches :
-c
-c   -----------------------------------------------------------------
-c     .... zplev  definis aux (llm +1) interfaces des couches  ....
-c     .... zplay  definis aux (  llm )    milieux des couches  .... 
-c   -----------------------------------------------------------------
-
-c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
-c
-       unskap   = 1./ kappa
-c
-      DO l = 1, llmp1
-        zplev( 1,l ) = pp(1,1,l)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              zplev( ig0,l ) = pp(i,j,l)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        zplev( ngridmx,l ) = pp(1,jjp1,l)
-      ENDDO
-c
-c
-
-c   43. temperature naturelle (en K) et pressions milieux couches .
-c   ---------------------------------------------------------------
-
-      DO l=1,llm
-
-         pksurcp     =  ppk(1,1,l) / cpp
-         zplay(1,l)  =  preff * pksurcp ** unskap
-         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
-         ig0         =  2
-
-         DO j = 2, jjm
-            DO i = 1, iim
-              pksurcp        = ppk(i,j,l) / cpp
-              zplay(ig0,l)   = preff * pksurcp ** unskap
-              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
-              ig0            = ig0 + 1
-            ENDDO
-         ENDDO
-
-         pksurcp       = ppk(1,jjp1,l) / cpp
-         zplay(ig0,l)  = preff * pksurcp ** unskap
-         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
-
-      ENDDO
-
-      DO l=1, llm
-        DO ig=1,ngridmx
-             if (ztfi(ig,l).lt.15) then
-                  write(*,*) 'New Temperature below 15 K !!! '
-	              write(*,*) 'Stop in calfis.F '
-	              write(*,*) 'ig=', ig, ' l=', l
-                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
-                  stop
-             end if
-        ENDDO
-      ENDDO
-
-
-
-c   43.bis Taceurs (en kg/kg)
-c   --------------------------
-      DO iq=1,nq
-         DO l=1,llm
-            zqfi(1,l,iq) = pq(1,1,l,iq)
-            ig0          = 2
-            DO j=2,jjm
-               DO i = 1, iim
-                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
-                  ig0             = ig0 + 1
-               ENDDO
-            ENDDO
-            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
-         ENDDO
-      ENDDO
-
-c   Geopotentiel calcule par rapport a la surface locale:
-c   -----------------------------------------------------
-
-      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
-      DO l=1,llm
-         DO ig=1,ngridmx
-            zphi(ig,l)=zphi(ig,l)-zphis(ig)
-         ENDDO
-      ENDDO
-
-c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
-c   -------------------------------
-c     pw est en kg/s
-c On interpole "lineairement" la temperature entre les couches(FF,10/95)
-
-!      DO ig=1,ngridmx
-!         zvervel(ig,1)=0.
-!      END DO
-!      DO l=2,llm
-!        zvervel(1,l)=(pw(1,1,l)/apoln)
-!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
-!        ig0=2
-!       DO j=2,jjm
-!           DO i = 1, iim
-!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
-!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!              ig0 = ig0 + 1
-!           ENDDO
-!       ENDDO
-!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
-!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
-!      ENDDO
-
-c    .........  Reindexation : calcul de zvervel au MILIEU des couches
-!       DO l=1,llm-1
-!	      DO ig=1,ngridmx
-!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
-!          END DO 
-!       END DO 
-c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
-
-c   45. champ u:
-c   ------------
-
-      DO 50 l=1,llm
-
-         DO 25 j=2,jjm
-            ig0 = 1+(j-2)*iim
-            zufi(ig0+1,l)= 0.5 * 
-     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
-            DO 10 i=2,iim
-               zufi(ig0+i,l)= 0.5 *
-     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
-10         CONTINUE
-25      CONTINUE
-
-50    CONTINUE
-
-
-c   46.champ v:
-c   -----------
-
-      DO l=1,llm
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               zvfi(ig0+i,l)= 0.5 *
-     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
-            ENDDO
-         ENDDO
-      ENDDO
-
-
-c   47. champs de vents aux pole nord   
-c   ------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
-         ENDDO
-
-         DO i=1,iim
-            zcos(i)   = COS(rlonv(i))*z1(i)
-            zcosbis(i)= COS(rlonv(i))*z1bis(i)
-            zsin(i)   = SIN(rlonv(i))*z1(i)
-            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
-         ENDDO
-
-         zufi(1,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-
-c   48. champs de vents aux pole sud:
-c   ---------------------------------
-c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
-c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
-
-      DO l=1,llm
-
-         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
-         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
-         DO i=2,iim
-            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
-            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
-      ENDDO
-
-         DO i=1,iim
-            zcos(i)    = COS(rlonv(i))*z1(i)
-            zcosbis(i) = COS(rlonv(i))*z1bis(i)
-            zsin(i)    = SIN(rlonv(i))*z1(i)
-            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
-      ENDDO
-
-         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
-         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c   Appel de la physique:
-c   ---------------------
-
-
-      CALL physiq (ngridmx,llm,nq,
-     ,     debut,lafin,
-     ,     rday_ecri,heure,dtphys,
-     ,     zplev,zplay,zphi,
-     ,     zufi, zvfi,ztfi, zqfi,  
-!     ,     zvervel,
-     ,     pw,
-C - sorties
-     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
-
-
-c-----------------------------------------------------------------------
-c   transformation des tendances physiques en tendances dynamiques:
-c   ---------------------------------------------------------------
-
-c  tendance sur la pression :
-c  -----------------------------------
-
-      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
-c
-ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
-
-c   62. enthalpie potentielle
-c   ---------------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
-          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
-            ENDDO
-               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   62. humidite specifique
-c   ---------------------
-
-      DO iq=1,nq
-         DO l=1,llm
-            DO i=1,iip1
-               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
-               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
-            ENDDO
-            DO j=2,jjm
-               ig0=1+(j-2)*iim
-               DO i=1,iim
-                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
-               ENDDO
-               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
-            ENDDO
-         ENDDO
-      ENDDO
-
-c   65. champ u:
-c   ------------
-
-      DO l=1,llm
-
-         DO i=1,iip1
-            pdufi(i,1,l)    = 0.
-            pdufi(i,jjp1,l) = 0.
-         ENDDO
-
-         DO j=2,jjm
-            ig0=1+(j-2)*iim
-            DO i=1,iim-1
-               pdufi(i,j,l)=
-     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
-            ENDDO
-            pdufi(iim,j,l)=
-     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
-            pdufi(iip1,j,l)=pdufi(1,j,l)
-         ENDDO
-
-      ENDDO
-
-
-c   67. champ v:
-c   ------------
-
-      DO l=1,llm
-
-         DO j=2,jjm-1
-            ig0=1+(j-2)*iim
-            DO i=1,iim
-               pdvfi(i,j,l)=
-     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
-            ENDDO
-            pdvfi(iip1,j,l) = pdvfi(1,j,l)
-         ENDDO
-      ENDDO
-
-
-c   68. champ v pres des poles:
-c   ---------------------------
-c      v = U * cos(long) + V * SIN(long)
-
-      DO l=1,llm
-
-         DO i=1,iim
-            pdvfi(i,1,l)=
-     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
-            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
-     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
-            pdvfi(i,1,l)=
-     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
-            pdvfi(i,jjm,l)=
-     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
-          ENDDO
-
-         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
-         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-
-700   CONTINUE
-
-      firstcal = .FALSE.
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/gcm.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1399)
+++ trunk/LMDZ.MARS/libf/dyn3d/gcm.F	(revision 1403)
@@ -5,4 +5,5 @@
      &                       nday_r, idissip, iconser, ecritstart,
      &                       ecritphy
+      use filtreg_mod, only: inifilr
 !      use comgeomphy, only: initcomgeomphy
       IMPLICIT NONE
@@ -107,5 +108,5 @@
 
       EXTERNAL caldyn, traceur
-      EXTERNAL dissip,geopot,iniconst,inifilr
+      EXTERNAL dissip,geopot,iniconst
       EXTERNAL integrd,SCOPY
       EXTERNAL inigeom
Index: trunk/LMDZ.MARS/libf/dyn3d/gr_dyn_fi.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/gr_dyn_fi.F	(revision 1399)
+++ 	(revision )
@@ -1,37 +1,0 @@
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-            ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/gr_fi_dyn.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/gr_fi_dyn.F	(revision 1399)
+++ 	(revision )
@@ -1,38 +1,0 @@
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-      EXTERNAL SCOPY
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/grid_noro1.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/grid_noro1.F	(revision 1399)
+++ 	(revision )
@@ -1,423 +1,0 @@
-      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
-     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Calcul des parametres de l'orographie sous-maille necessaires
-c      au nouveau shema de representation des montagnes meso-echelles
-c      dans le modele.  Les points sont mis sur une grille rectangulaire
-c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
-c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
-c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
-c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
-c      en j=1.  
-c      Les parametres a,b,c,d representent les limites de la region
-c      de point de grille correspondant a un point decrit precedemment.
-c      Les moyennes sur ces regions des valeurs calculees a partir de
-c      l'USN, sont ponderees par un poids, fonction de la surface
-c      occuppe par ces donnees a l'interieure de la grille du modele.
-c      Dans la plupart des cas ce poid est le rapport entre la surface
-c      de la region de point de grille USN et la surface de la region
-c      de point de grille du modele.
-c       
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c        dans ce programme, on assume que les donnees sont les altitudes
-c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        les champs de sorties sont sur une grille physique:
-c             zmea:  orographie moyenne
-c             zstd:  deviation standard de l'orographie sous-maille
-c             zsig:  pente de l'orographie sous-maille 
-c             zgam:  anisotropy de l'orographie sous maille
-c             zthe:  orientation de l'axe oriente dans la direction
-c                    de plus grande pente de l'orographie sous maille
-C=======================================================================
-c     IMPLICIT INTEGER (I,J)
-c     IMPLICIT REAL(X,Z) 
-       implicit none
-       integer iusn,jusn,iext
-       parameter(iusn=360,jusn=180,iext=40)
-c!-*-      include 'param1'
-c!-*-      include 'comcstfi.h'
-#include "dimensions.h"
-#include "comconst.h"
-c!-*-
-c!-*-      parameter(iim=cols,jjm=rows)
-      REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
-
-c   modif declarations pour implicit none
-      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
-      real zsigsud,zweinor,zweisud
-      real xk,xl,xm,xw,xp,xq
-      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
-      real zbordnor,zbordsud,zbordest,zbordoue,xpi
-      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
-      integer i,j,ii,jj,ideltax,ihalph
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL weight(iim+1,jjm+1)
-      REAL x(imar+1),y(jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-c
-c  quelques constantes:
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      print*,'rad =',rad
-      print*,'Long et lat entree'
-      print*,(x(i),i=1,imar+1)
-      print*,(y(j),j=1,jmar)
-       print*,'Long et lat donnees'
-      print*,(xdata(i),i=1,imdep)
-      print*,(ydata(j),j=1,jmdep)
-
-      xpi=acos(-1.)
-      zdeltay=2.*xpi/real(jusn)*rad
-c
-c  quelques tests de dimensions:
-c    
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
-        print *,' imar ou jmar mal dimensionnes:',imar,jmar
-        call abort
-      ENDIF
-c
-C  Extension de la base de donnee de l'USN pour faciliter
-C  les calculs ulterieurs:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=entree(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=entree(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=entree(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c
-c  Calcul d'une orographie filtree aux hautes latitudes
-c  pour permettre des calculs plus isotropiques sur la pente
-c  des montagnes
-c
-       DO i=1,IUSN+2*iext
-       DO J=1,JUSN+2
-          zusnfi(i,j)=0.0
-       ENDDO
-       ENDDO
-
-      DO j=1,jusn
-            ideltax=1./cos(yusn(j+1))
-            ideltax=min(iusn/2-1,ideltax)
-            IF(MOD(IDELTAX,2).EQ.0)THEN
-              IDELTAX=IDELTAX+1
-            ENDIF
-            IHALPH=(IDELTAX-1)/2 
-c           print *,' ideltax=',ideltax
-         IF(ideltax.eq.1)THEN
-            DO i=1,iusn
-               zusnfi(i+iext,j+1)=entree(i,j)
-            ENDDO   
-         ELSE
-            DO i=1,ihalph
-               DO ii=1,i+ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               DO ii=ihalph-i,0,-1
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
-               ENDDO  
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO   
-            DO i=iusn-ihalph+1,iusn
-               DO ii = i-ihalph,iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO 
-               DO ii = 1,ihalph+i-iusn
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO
-            DO i=ihalph+1,iusn-ihalph
-               DO ii=-ihalph,ihalph
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
-               ENDDO
-               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
-            ENDDO
-         ENDIF
-            DO i=1,iext
-               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
-               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
-            ENDDO
-      ENDDO
-c  
-c Calculer les limites des zones des nouveaux points
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-c
-c      quelques initialisations:
-      print*,'OKM1'
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         weight(i,j) = 0.0
-         zxtzx(i,j) = 0.0
-         zytzy(i,j) = 0.0
-         zxtzy(i,j) = 0.0
-         ztz(i,j) = 0.0
-         zmea(i,j) = 0.0
-         zstd(i,j)=0.0
-      ENDDO
-      ENDDO
-c
-c  calculs des correlations de pentes sur la grille de l'USN.
-c
-         DO j = 2,jusn+1 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
-         ENDDO
-
-         ENDDO
-
- 
-
-      print*,'OK0'
-c
-c  sommations des differentes quantites definies precedemment
-c  sur une grille du modele.
-c 
-      zleny=xpi/real(jusn)*rad
-      xincr=xpi/2./real(jusn)
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=amax1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=amax1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            weight(ii,jj)=weight(ii,jj)+weighx*weighy
-            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  calculs des differents parametres necessaires au programme
-c  de parametrisation de l'orographie a l'echelle moyenne:
-c
-      zmaxmea=0.
-      zmaxstd=0.
-      zmaxsig=0.
-      zmaxgam=0.
-      zmaxthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       print*,'OK1'
-       DO ii = 1, imar
-       DO jj = 1, jmar
-c       print*,'ok0'
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Orography moyenne:
-c         print*,'ok1'
-           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
-           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
-           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
-           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
-           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
-c         print*,'ok2'
-c  Deviation standard:
-           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-c  Coefficients K, L et M:
-           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-           xm=zxtzy(ii,jj)
-           xp=xk-sqrt(xl**2+xm**2)
-           xq=xk+sqrt(xl**2+xm**2)
-           xw=1.e-8
-           if(xp.le.xw) xp=0.
-           if(xq.le.xw) xq=xw
-           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
-c          print*,'ok3'
-c pente: 
-           zsig(ii,jj)=sqrt(xq)
-c           zsig(ii,jj)=sqrt(2.*xk)
-c isotropy:
-           zgam(ii,jj)=xp/xq
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
-
-c          print 101,ii,jj,
-c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
-c    *           zthe(ii,jj)
-c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
-c          print*,'ok4'
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-c          print*,'ok1b'
-         ENDIF
-      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
-c         print*,'oka'
-      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
-c         print*,'okb'
-      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
-c         print*,'okc'
-      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
-c         print*,'okd'
-      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
-c         print*,'oke'
-      zminthe=amin1(zthe(ii,jj),zminthe)
-c      print*,'ok5'
-       ENDDO
-       ENDDO
-
-      print *,'  MEAN ORO:',zmaxmea
-	  print *,'  ST. DEV.:',zmaxstd
-      print *,'  PENTE:',zmaxsig
-      print *,' ANISOTROP:',zmaxgam
-      print *,'  ANGLE:',zminthe,zmaxthe	
-      
-C
-c  On passe ce donnees sur la grille dite physique....(?)
-c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
-c  n'ont pas vraiment de sens
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(1,jj)
-      zstd(imar+1,jj)=zstd(1,jj)
-      zsig(imar+1,jj)=zsig(1,jj)
-      zgam(imar+1,jj)=zgam(1,jj)
-      zthe(imar+1,jj)=zthe(1,jj)
-      ENDDO
-
-
-      zmeanor=0.0
-      zmeasud=0.0
-      zstdnor=0.0
-      zstdsud=0.0
-      zsignor=0.0
-      zsigsud=0.0
-      zweinor=0.0
-      zweisud=0.0
-
-      DO ii=1,imar
-      zweinor=zweinor+              weight(ii,   1)
-      zweisud=zweisud+              weight(ii,jmar)
-      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
-      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
-      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
-      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
-      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
-      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/zweisud
-      zstd(ii,   1)=zstdnor/zweinor
-      zstd(ii,jmar)=zstdsud/zweisud
-      zsig(ii,   1)=zsignor/zweinor
-      zsig(ii,jmar)=zsigsud/zweisud
-      zgam(ii,   1)=1.
-      zgam(ii,jmar)=1.
-      zthe(ii,   1)=0.
-      zthe(ii,jmar)=0.
-      ENDDO
-
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/interp_vert.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/interp_vert.F	(revision 1399)
+++ 	(revision )
@@ -1,70 +1,0 @@
-c******************************************************
-      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
-     &             aps,bps,ps,Nhoriz)
-c
-c interpolation lineaire pour passer
-c a une nouvelle discretisation verticale pour
-c les variables de GCM
-c Francois Forget (01/1995)
-c Modif pour coordonnees hybrides FF (03/2003)
-c**********************************************************
-
-      IMPLICIT NONE
-
-c   Declarations:
-c ==============
-c
-c  ARGUMENTS
-c  """""""""
-
-       integer lmo ! dimensions ancienne couches (input)
-       integer lmn ! dimensions nouvelle couches (input)
-
-       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
-       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (input)
-
-       integer Nhoriz ! nombre de point horizontale (input)
-       real ps(nhoriz) !pression de surface (input)
-
-       real varo(Nhoriz,lmo) ! var dans l''ancienne grille (input)
-       real varn(Nhoriz,lmn) ! var dans la nouvelle grille (output)
-
-c Autres variables
-c """"""""""""""""
-       integer n, ln ,lo 
-       real coef
-       REAL sigmo(lmo) ! niveau sigma des variables dans les anciennes coord
-       REAL sigmn(lmn) ! niveau sigma des variables dans les nouvelles coord
-
-c run
-c ====
-
-      do n=1,Nhoriz
-        do ln=1,lmn
-            sigmn(ln)=aps(ln)/ps(n)+bps(ln)
-        end do
-        do lo=1,lmo
-            sigmo(lo)=apso(lo)/ps(n)+bpso(lo)
-        end do
-
-        do ln=1,lmn
-           if (sigmn(ln).ge.sigmo(1))then
-             varn(n,ln) =  varo(n,1)  
-           else if (sigmn(ln).le.sigmo(lmo)) then
-             varn(n,ln) =  varo(n,lmo)
-           else
-              do lo =1,lmo-1 
-                if ( (sigmn(ln).le.sigmo(lo)).and.
-     &             (sigmn(ln).gt.sigmo(lo+1)) )then
-                  coef = (sigmn(ln)-sigmo(lo))/(sigmo(lo+1)-sigmo(lo))
-                   varn(n,ln)=varo(n,lo) +coef*(varo(n,lo+1)-varo(n,lo))
-                end if
-              end do           
-           end if
-         end do
-
-      end do
-
-
-      return
-      end
Index: trunk/LMDZ.MARS/libf/dyn3d/logic.h
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/logic.h	(revision 1399)
+++ trunk/LMDZ.MARS/libf/dyn3d/logic.h	(revision 1403)
@@ -1,10 +1,10 @@
-c-----------------------------------------------------------------------
-c INCLUDE 'logic.h'
+!-----------------------------------------------------------------------
+! INCLUDE 'logic.h'
 
-      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,
-     *  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+      COMMON/logic/ purmats,physic,forward,leapf,apphys,grireg,         &
+     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
 
-      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser,
-     * apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
+      LOGICAL purmats,physic,forward,leapf,apphys,grireg,statcl,conser, &
+     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus,hybrid
 
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
Index: trunk/LMDZ.MARS/libf/dyn3d/readhead_NC.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/readhead_NC.F	(revision 1399)
+++ 	(revision )
@@ -1,231 +1,0 @@
-      SUBROUTINE readhead_NC (fichnom,
-     .           day0,
-     .           phis,constR)
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c  Adaptation à Mars : Yann Wanherdrick 
-c Objet: Lecture de l etat initial pour la physique
-c======================================================================
-#include "netcdf.inc"
-c====== includes de l ancien readhead ===
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "ener.h"
-#include "description.h"
-
-c======================================================================
-
-      CHARACTER*(*) fichnom
-      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
-      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
-
-      INTEGER radpas
-
-      REAL xmin, xmax
-c
-      INTEGER  i
-
-c   Variables
-c
-      INTEGER length,iq
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr, nid, nvarid
-      CHARACTER  str3*3
-
-c
-      INTEGER day0
-      REAL phis(ip1jmp1),constR
-c
-c Ouvrir le fichier contenant l etat initial:
-c
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        CALL ABORT
-      ENDIF
-c
-c Lecture des parametres de controle:
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Le champ <controle> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Lecture echouee pour <controle>'
-         CALL abort
-      ENDIF
-
-
-c Info sur la Planete Mars pour la dynamique 
-      im         = tab_cntrl(1)
-      jm         = tab_cntrl(2)
-      lllm       = tab_cntrl(3)
-      day_ini    = tab_cntrl(4)
-      rad        = tab_cntrl(5)
-      omeg       = tab_cntrl(6)
-      g          = tab_cntrl(7)
-c      mugaz      = tab_cntrl(8)
-      cpp        =  744.499
-      kappa      = tab_cntrl(9)
-      daysec     = tab_cntrl(10)
-      dtvr       = tab_cntrl(11)
-      etot0      = tab_cntrl(12)
-      ptot0      = tab_cntrl(13)
-      ztot0      = tab_cntrl(14)
-      stot0      = tab_cntrl(15)
-      ang0       = tab_cntrl(16)
-c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
-      preff=610.
-      WRITE (*,*) 'readhead -     preff ' , preff 
-c
-
-      day0=day_ini
-
-      constR=kappa*cpp
-      WRITE (*,*) 'constR = ' , constR
-      r=constR
-      IF(   im.ne.iim           )  THEN
-          PRINT 1,im,iim
-          STOP
-      ELSE  IF( jm.ne.jjm       )  THEN
-          PRINT 2,jm,jjm
-          STOP
-      ELSE  IF( lllm.ne.llm     )  THEN
-          PRINT 3,lllm,llm
-          STOP
-      ENDIF
-                                                                       
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <rlonu> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <rlonu>"
-         CALL abort
-      ENDIF
-                                                                       
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <rlatv> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour rlatv"
-         CALL abort
-      ENDIF
-
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
-         CALL abort
-      ENDIF
-c
-c Lecture des aires des mailles:
-c
-      ierr = NF_INQ_VARID (nid, "aire", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Le champ <aire> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      xmin = MINVAL(aire)
-      xmax = MAXVAL(aire)
-      PRINT*,'Aires des mailles <aire>:', xmin, xmax
-c
-c Lecture du geopotentiel au sol:
-c
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
-         CALL abort
-      ENDIF
-c      PRINT*,'READHEAD_NC  Phis:',phis
-
-      ierr = NF_INQ_VARID (nid, "aps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <aps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "bps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Le champ <bps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
-         CALL abort
-      ENDIF
-
-   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur parametree llm =',i4//)
-   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur  dtinteg =',i4//)
-
-      
-c Fermer le fichier:
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/scal_wind.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/scal_wind.F	(revision 1399)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      SUBROUTINE scal_wind(xus,xvs,xu,xv)
-c=======================================================================
-c
-c
-c   Subject:
-c   ------
-c On passe  les variable xus, xvs  aux points de vent u et v (xu et xv)
-c
-c=======================================================================
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c   Arguments:
-c   ----------
-
-      REAL xu(iip1,jjp1,llm),xv(iip1,jjm,llm)
-      REAL xus(iip1,jjp1,llm), xvs (iip1,jjp1,llm)
-
-c   Local:
-c   ------
-
-      INTEGER i,j,l
-
-c-----------------------------------------------------------------------
-
-c   transport zonal:
-c   ----------------
-      DO l=1,llm
-        Do j=1,jjp1
-	      DO i=1,iim
-            xu(i,j,l)=0.5*(xus(i,j,l)+xus(i+1,j,l))
-	      ENDDO
-          xu(iip1,j,l)=xu(1,j,l)
-	    ENDDO
-      ENDDO
-
-
-c   Transport meridien:
-c   -------------------
-      DO l=1,llm
-         DO j=1,jjm
-           do i=1 ,iip1
-	         xv(i,j,l)=.5*(xvs(i,j,l)+xvs(i,j+1,l))
-           end do
-	     ENDDO
-	  ENDDO
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dyn3d/serre.h
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/serre.h	(revision 1399)
+++ trunk/LMDZ.MARS/libf/dyn3d/serre.h	(revision 1403)
@@ -1,6 +1,6 @@
-c..include serre.h
-c
-       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
-       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
-     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+!..include serre.h
+!
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: trunk/LMDZ.MARS/libf/dyn3d/wind_scal.F
===================================================================
--- trunk/LMDZ.MARS/libf/dyn3d/wind_scal.F	(revision 1399)
+++ 	(revision )
@@ -1,55 +1,0 @@
-      SUBROUTINE wind_scal(pbaru,pbarv,us,vs)
-c=======================================================================
-c
-c
-c   Subject:
-c   ------
-c   On ramene les flux de masse /vents  aux points scalaires.
-c
-c=======================================================================
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c   Arguments:
-c   ----------
-
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-      REAL us(ip1jmp1,llm), vs (ip1jmp1,llm)
-
-c   Local:
-c   ------
-
-      INTEGER ij,l
-
-c-----------------------------------------------------------------------
-
-c   transport zonal:
-c   ----------------
-      DO l=1,llm
-	 DO ij=2,ip1jmp1
-            us(ij,l)=.5*(pbaru(ij,l)+pbaru(ij-1,l))
-	 ENDDO
-      ENDDO
-      CALL SCOPY(jjp1*llm,us(iip1,1),iip1,us(1,1),iip1)
-
-
-c   Transport meridien:
-c   -------------------
-      DO l=1,llm
-         DO ij=iip2,ip1jm
-	    vs(ij,l)=.5*(pbarv(ij,l)+pbarv(ij-iip1,l))
-	 ENDDO
-	 DO ij=1,iip1
-	    vs(ij,l)=0.
-	    vs(ip1jm+ij,l)=0.
-	 ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/calfis.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/calfis.F	(revision 1403)
@@ -0,0 +1,554 @@
+      SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
+     $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
+     $            pducov,pdvcov,pdteta,pdq,pw,
+     $            pdufi,pdvfi,pdhfi,pdqfi,pdpsfi,tracer )
+c
+c    Auteur :  P. Le Van, F. Hourdin 
+c   .........
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c   1. rearrangement des tableaux et transformation
+c      variables dynamiques  >  variables physiques
+c   2. calcul des termes physiques
+c   3. retransformation des tendances physiques en tendances dynamiques
+c
+c   remarques:
+c   ----------
+c
+c    - les vents sont donnes dans la physique par leurs composantes 
+c      naturelles.
+c    - la variable thermodynamique de la physique est une variable
+c      intensive :   T 
+c      pour la dynamique on prend    T * ( preff / p(l) ) **kappa
+c    - les deux seules variables dependant de la geometrie necessaires
+c      pour la physique sont la latitude pour le rayonnement et 
+c      l'aire de la maille quand on veut integrer une grandeur 
+c      horizontalement.
+c    - les points de la physique sont les points scalaires de la 
+c      la dynamique; numerotation:
+c          1 pour le pole nord
+c          (jjm-1)*iim pour l'interieur du domaine
+c          ngridmx pour le pole sud
+c      ---> ngridmx=2+(jjm-1)*iim
+c
+c     Input :
+c     -------
+c       ecritphy        frequence d'ecriture (en jours)de histphy
+c       pucov           covariant zonal velocity
+c       pvcov           covariant meridional velocity 
+c       pteta           potential temperature
+c       pps             surface pressure
+c       pmasse          masse d'air dans chaque maille
+c       pts             surface temperature  (K)
+c       pw              flux vertical (kg/s)
+c
+c    Output :
+c    --------
+c        pdufi          tendency for the natural zonal velocity (ms-1)
+c        pdvfi          tendency for the natural meridional velocity 
+c        pdhfi          tendency for the potential temperature
+c        pdtsfi         tendency for the surface temperature
+c
+c        tracer         Call tracer in  gcm.F ? (decided in callphys.def)
+c
+c=======================================================================
+c
+c-----------------------------------------------------------------------
+c
+c    0.  Declarations :
+c    ------------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+
+      INTEGER ngridmx,nq
+      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
+
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+!#include "control.h"
+
+c    Arguments :
+c    -----------
+      LOGICAL  lafin
+      REAL heure
+
+      REAL pvcov(iip1,jjm,llm)
+      REAL pucov(iip1,jjp1,llm)
+      REAL pteta(iip1,jjp1,llm)
+      REAL pmasse(iip1,jjp1,llm)
+      REAL pq(iip1,jjp1,llm,nq)
+      REAL pphis(iip1,jjp1)
+      REAL pphi(iip1,jjp1,llm)
+c
+      REAL pdvcov(iip1,jjm,llm)
+      REAL pducov(iip1,jjp1,llm)
+      REAL pdteta(iip1,jjp1,llm)
+      REAL pdq(iip1,jjp1,llm,nq)
+c
+      REAL pw(iip1,jjp1,llm)
+c
+      REAL pps(iip1,jjp1)
+      REAL pp(iip1,jjp1,llmp1)
+      REAL ppk(iip1,jjp1,llm)
+c
+      REAL pdvfi(iip1,jjm,llm)
+      REAL pdufi(iip1,jjp1,llm)
+      REAL pdhfi(iip1,jjp1,llm)
+      REAL pdqfi(iip1,jjp1,llm,nq)
+      REAL pdpsfi(iip1,jjp1)
+      logical tracer
+
+c    Local variables :
+c    -----------------
+
+      INTEGER i,j,l,ig0,ig,iq
+      REAL zpsrf(ngridmx)
+      REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
+      REAL zphi(ngridmx,llm),zphis(ngridmx)
+c
+      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
+      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nq)
+c
+      REAL zvervel(ngridmx,llm)
+c
+      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
+      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nq)
+      REAL zdpsrf(ngridmx)
+c
+      REAL zsin(iim),zcos(iim),z1(iim)
+      REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
+      REAL unskap, pksurcp
+c
+      
+      EXTERNAL gr_dyn_fi,gr_fi_dyn
+      EXTERNAL physiq,multipl
+      REAL SSUM
+      EXTERNAL SSUM
+
+      REAL latfi(ngridmx),lonfi(ngridmx)
+      REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
+
+      LOGICAL firstcal, debut
+      DATA firstcal/.true./
+      SAVE firstcal,debut
+      REAL rdayvrai,rday_ecri
+c
+c-----------------------------------------------------------------------
+c
+c    1. Initialisations :
+c    --------------------
+c
+
+
+      IF (ngridmx.NE.2+(jjm-1)*iim) THEN
+         PRINT*,'STOP dans calfis'
+         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         PRINT*,'  ngridmx  jjm   iim   '
+         PRINT*,ngridmx,jjm,iim
+         STOP
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   latitude, longitude et aires des mailles pour la physique:
+c   ----------------------------------------------------------
+
+c
+      IF ( firstcal )  THEN
+          debut = .TRUE.
+      ELSE
+          debut = .FALSE.
+      ENDIF
+
+c
+!      IF (firstcal) THEN
+!         latfi(1)=rlatu(1)
+!         lonfi(1)=0.
+!         DO j=2,jjm
+!            DO i=1,iim
+!               latfi((j-2)*iim+1+i)= rlatu(j)
+!               lonfi((j-2)*iim+1+i)= rlonv(i)
+!            ENDDO
+!         ENDDO
+!         latfi(ngridmx)= rlatu(jjp1)
+!         lonfi(ngridmx)= 0.
+!         
+!         ! build airefi(), mesh area on physics grid
+!         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+!         ! Poles are single points on physics grid
+!         airefi(1)=airefi(1)*iim
+!         airefi(ngridmx)=airefi(ngridmx)*iim
+!
+!         CALL inifis(ngridmx,llm,nq,day_ini,daysec,dtphys,
+!     .                latfi,lonfi,airefi,rad,g,r,cpp)
+!      ENDIF
+
+c
+c-----------------------------------------------------------------------
+c   40. transformation des variables dynamiques en variables physiques:
+c   ---------------------------------------------------------------
+
+c   41. pressions au sol (en Pascals)
+c   ----------------------------------
+
+       
+      zpsrf(1) = pps(1,1)
+
+      ig0  = 2
+      DO j = 2,jjm
+         CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
+         ig0 = ig0+iim
+      ENDDO
+
+      zpsrf(ngridmx) = pps(1,jjp1)
+
+
+c   42. pression intercouches :
+c
+c   -----------------------------------------------------------------
+c     .... zplev  definis aux (llm +1) interfaces des couches  ....
+c     .... zplay  definis aux (  llm )    milieux des couches  .... 
+c   -----------------------------------------------------------------
+
+c    ...    Exner = cp * ( p(l) / preff ) ** kappa     ....
+c
+       unskap   = 1./ kappa
+c
+      DO l = 1, llmp1
+        zplev( 1,l ) = pp(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              zplev( ig0,l ) = pp(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        zplev( ngridmx,l ) = pp(1,jjp1,l)
+      ENDDO
+c
+c
+
+c   43. temperature naturelle (en K) et pressions milieux couches .
+c   ---------------------------------------------------------------
+
+      DO l=1,llm
+
+         pksurcp     =  ppk(1,1,l) / cpp
+         zplay(1,l)  =  preff * pksurcp ** unskap
+         ztfi(1,l)   =  pteta(1,1,l) *  pksurcp
+         ig0         =  2
+
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = ppk(i,j,l) / cpp
+              zplay(ig0,l)   = preff * pksurcp ** unskap
+              ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+
+         pksurcp       = ppk(1,jjp1,l) / cpp
+         zplay(ig0,l)  = preff * pksurcp ** unskap
+         ztfi (ig0,l)  = pteta(1,jjp1,l)  * pksurcp
+
+      ENDDO
+
+      DO l=1, llm
+        DO ig=1,ngridmx
+             if (ztfi(ig,l).lt.15) then
+                  write(*,*) 'New Temperature below 15 K !!! '
+	              write(*,*) 'Stop in calfis.F '
+	              write(*,*) 'ig=', ig, ' l=', l
+                      write(*,*) 'ztfi(ig,l)=',ztfi(ig,l)
+                  stop
+             end if
+        ENDDO
+      ENDDO
+
+
+
+c   43.bis Taceurs (en kg/kg)
+c   --------------------------
+      DO iq=1,nq
+         DO l=1,llm
+            zqfi(1,l,iq) = pq(1,1,l,iq)
+            ig0          = 2
+            DO j=2,jjm
+               DO i = 1, iim
+                  zqfi(ig0,l,iq)  = pq(i,j,l,iq)
+                  ig0             = ig0 + 1
+               ENDDO
+            ENDDO
+            zqfi(ig0,l,iq) = pq(1,jjp1,l,iq)
+         ENDDO
+      ENDDO
+
+c   Geopotentiel calcule par rapport a la surface locale:
+c   -----------------------------------------------------
+
+      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
+      DO l=1,llm
+         DO ig=1,ngridmx
+            zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
+      ENDDO
+
+c   Calcul de la vitesse  verticale (m/s) pour diagnostique 
+c   -------------------------------
+c     pw est en kg/s
+c On interpole "lineairement" la temperature entre les couches(FF,10/95)
+
+!      DO ig=1,ngridmx
+!         zvervel(ig,1)=0.
+!      END DO
+!      DO l=2,llm
+!        zvervel(1,l)=(pw(1,1,l)/apoln)
+!     &  * r *0.5*(ztfi(1,l)+ztfi(1,l-1)) /zplev(1,l)              
+!        ig0=2
+!       DO j=2,jjm
+!           DO i = 1, iim
+!              zvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+!     &        * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!              ig0 = ig0 + 1
+!           ENDDO
+!       ENDDO
+!        zvervel(ig0,l)=(pw(1,jjp1,l)/apols)
+!     &  * r *0.5*(ztfi(ig0,l)+ztfi(ig0,l-1)) /zplev(ig0,l)              
+!      ENDDO
+
+c    .........  Reindexation : calcul de zvervel au MILIEU des couches
+!       DO l=1,llm-1
+!	      DO ig=1,ngridmx
+!		     zvervel(ig,l) = 0.5*(zvervel(ig,l)+zvervel(ig,l+1))
+!          END DO 
+!       END DO 
+c      (dans la couche llm, on garde la valeur à la limite inférieure llm)
+
+c   45. champ u:
+c   ------------
+
+      DO 50 l=1,llm
+
+         DO 25 j=2,jjm
+            ig0 = 1+(j-2)*iim
+            zufi(ig0+1,l)= 0.5 * 
+     $      ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
+            DO 10 i=2,iim
+               zufi(ig0+i,l)= 0.5 *
+     $         ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
+10         CONTINUE
+25      CONTINUE
+
+50    CONTINUE
+
+
+c   46.champ v:
+c   -----------
+
+      DO l=1,llm
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               zvfi(ig0+i,l)= 0.5 *
+     $         ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
+            ENDDO
+         ENDDO
+      ENDDO
+
+
+c   47. champs de vents aux pole nord   
+c   ------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
+         ENDDO
+
+         DO i=1,iim
+            zcos(i)   = COS(rlonv(i))*z1(i)
+            zcosbis(i)= COS(rlonv(i))*z1bis(i)
+            zsin(i)   = SIN(rlonv(i))*z1(i)
+            zsinbis(i)= SIN(rlonv(i))*z1bis(i)
+         ENDDO
+
+         zufi(1,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(1,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+
+c   48. champs de vents aux pole sud:
+c   ---------------------------------
+c        U = 1 / pi  *  integrale [ v * cos(long) * d long ]
+c        V = 1 / pi  *  integrale [ v * sin(long) * d long ]
+
+      DO l=1,llm
+
+         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
+         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
+         DO i=2,iim
+            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
+            z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
+      ENDDO
+
+         DO i=1,iim
+            zcos(i)    = COS(rlonv(i))*z1(i)
+            zcosbis(i) = COS(rlonv(i))*z1bis(i)
+            zsin(i)    = SIN(rlonv(i))*z1(i)
+            zsinbis(i) = SIN(rlonv(i))*z1bis(i)
+      ENDDO
+
+         zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
+         zvfi(ngridmx,l)  = SSUM(iim,zsin,1)/pi
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c   Appel de la physique:
+c   ---------------------
+
+
+      CALL physiq (ngridmx,llm,nq,
+     ,     debut,lafin,
+     ,     rday_ecri,heure,dtphys,
+     ,     zplev,zplay,zphi,
+     ,     zufi, zvfi,ztfi, zqfi,  
+!     ,     zvervel,
+     ,     pw,
+C - sorties
+     s     zdufi, zdvfi, zdtfi, zdqfi,zdpsrf,tracer)
+
+
+c-----------------------------------------------------------------------
+c   transformation des tendances physiques en tendances dynamiques:
+c   ---------------------------------------------------------------
+
+c  tendance sur la pression :
+c  -----------------------------------
+
+      CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
+c
+ccc     CALL multipl(ip1jmp1,aire,pdpsfi,pdpsfi)
+
+c   62. enthalpie potentielle
+c   ---------------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+          pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
+          pdhfi(i,jjp1,l) = cpp *  zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
+            ENDDO
+               pdhfi(iip1,j,l) =  pdhfi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   62. humidite specifique
+c   ---------------------
+
+      DO iq=1,nq
+         DO l=1,llm
+            DO i=1,iip1
+               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
+               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
+            ENDDO
+            DO j=2,jjm
+               ig0=1+(j-2)*iim
+               DO i=1,iim
+                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
+               ENDDO
+               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
+            ENDDO
+         ENDDO
+      ENDDO
+
+c   65. champ u:
+c   ------------
+
+      DO l=1,llm
+
+         DO i=1,iip1
+            pdufi(i,1,l)    = 0.
+            pdufi(i,jjp1,l) = 0.
+         ENDDO
+
+         DO j=2,jjm
+            ig0=1+(j-2)*iim
+            DO i=1,iim-1
+               pdufi(i,j,l)=
+     $         0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
+            ENDDO
+            pdufi(iim,j,l)=
+     $      0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
+            pdufi(iip1,j,l)=pdufi(1,j,l)
+         ENDDO
+
+      ENDDO
+
+
+c   67. champ v:
+c   ------------
+
+      DO l=1,llm
+
+         DO j=2,jjm-1
+            ig0=1+(j-2)*iim
+            DO i=1,iim
+               pdvfi(i,j,l)=
+     $         0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
+            ENDDO
+            pdvfi(iip1,j,l) = pdvfi(1,j,l)
+         ENDDO
+      ENDDO
+
+
+c   68. champ v pres des poles:
+c   ---------------------------
+c      v = U * cos(long) + V * SIN(long)
+
+      DO l=1,llm
+
+         DO i=1,iim
+            pdvfi(i,1,l)=
+     $      zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
+            pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
+     $      +zdvfi(ngridmx,l)*SIN(rlonv(i))
+            pdvfi(i,1,l)=
+     $      0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
+            pdvfi(i,jjm,l)=
+     $      0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
+          ENDDO
+
+         pdvfi(iip1,1,l)  = pdvfi(1,1,l)
+         pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+
+700   CONTINUE
+
+      firstcal = .FALSE.
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_dyn_fi.F	(revision 1403)
@@ -0,0 +1,37 @@
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
+c   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+
+c   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/gr_fi_dyn.F	(revision 1403)
@@ -0,0 +1,38 @@
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+c=======================================================================
+c   passage d'un champ de la grille scalaire a la grille physique
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+
+      INTEGER i,j,ifield,ig
+      EXTERNAL SCOPY
+
+c-----------------------------------------------------------------------
+c   calcul:
+c   -------
+
+      DO ifield=1,nfield
+c   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+
+c   traitement des point normaux
+         DO j=2,jm-1
+	    ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,453 @@
+!
+!$Header$
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  ! Ehouarn: handle 1D case:
+  if ((iim.eq.1).and.(jjp1.eq.2)) then
+    nbp_lat=1
+    klon_glo=1
+  endif
+  
+  END SUBROUTINE init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  fonctions generiques (privees)
+!---------------------------------------------------------------- 
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,211 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+       klon_glo=iim*(jjp1-2)+2
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+      ! Ehouarn: handle 1D case:
+      if (klon_glo.eq.1) then
+        klon_mpi_para_end(i) = 1
+        klon_mpi_para_nb(i) = 1
+        ij_para_end(i) = 1
+        jj_para_end(i) = 1
+        ii_para_end(i) = 1
+      endif
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h" 
+  
+    WRITE(*,*) 'ii_begin =', ii_begin
+    WRITE(*,*) 'ii_end =', ii_end
+    WRITE(*,*) 'jj_begin =',jj_begin
+    WRITE(*,*) 'jj_end =', jj_end
+    WRITE(*,*) 'jj_nb =', jj_nb
+    WRITE(*,*) 'ij_begin =', ij_begin
+    WRITE(*,*) 'ij_end =', ij_end
+    WRITE(*,*) 'ij_nb =', ij_nb
+    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(*,*) 'klon_mpi =', klon_mpi
+    WRITE(*,*) 'jj_para_nb =', jj_para_nb
+    WRITE(*,*) 'jj_para_begin =', jj_para_begin
+    WRITE(*,*) 'jj_para_end =', jj_para_end
+    WRITE(*,*) 'ii_para_begin =', ii_para_begin
+    WRITE(*,*) 'ii_para_end =', ii_para_end
+    WRITE(*,*) 'ij_para_nb =', ij_para_nb
+    WRITE(*,*) 'ij_para_begin =', ij_para_begin
+    WRITE(*,*) 'ij_para_end =', ij_para_end
+    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(*,*) 'mpi_rank =', mpi_rank
+    WRITE(*,*) 'mpi_size =', mpi_size
+    WRITE(*,*) 'mpi_root =', mpi_root
+    WRITE(*,*) 'is_mpi_root =', is_mpi_root
+    WRITE(*,*) 'is_north_pole =', is_north_pole
+    WRITE(*,*) 'is_south_pole =', is_south_pole
+    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1906 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_transfert
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+		     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_mpi
+    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+		     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D_mpi
+    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+		     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+		     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum_mpi
+    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE 
+
+ INTERFACE grid1dTo2d_mpi
+    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
+                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
+		     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
+ END INTERFACE 
+
+ INTERFACE grid2dTo1d_mpi
+    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
+                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
+		     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
+ END INTERFACE 
+    
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL scatter_mpi_igen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
+    
+  END SUBROUTINE scatter_mpi_i1
+  
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,1)
+  
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_r1
+  
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_l1
+  
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_i
+  
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i2
+  
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_R
+
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r1
+
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r2
+  
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_r3
+  
+  
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l
+
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE scatter2D_mpi_l1
+
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+  
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l2
+  
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i2
+  
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+ 
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i3
+
+
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r2
+  
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r3
+
+  
+  
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l2
+  
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i4                  
+  
+  
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+     
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r4 
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_i
+  
+
+  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i1
+
+  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i2
+  
+  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i3
+
+
+  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_r
+  
+
+  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r1
+
+  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r2
+  
+  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_l
+  
+
+  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l1
+
+  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l2
+  
+  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l3
+
+
+  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_i
+  
+
+  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i1
+
+  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i2
+  
+  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_r
+  
+
+  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r1
+
+  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r2
+  
+  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r3
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_l
+  
+
+  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l1
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l2
+
+  
+  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l3
+
+               
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+    
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
+    if (ierr.ne.MPI_SUCCESS) then
+      write(*,*) "bcast_mpi error: ierr=",ierr
+      stop
+    endif
+#endif
+
+  END SUBROUTINE bcast_mpi_lgen
+
+  
+
+  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
+                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_igen
+
+  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+
+#endif
+
+  END SUBROUTINE scatter_mpi_rgen
+
+  
+  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_lgen  
+
+
+
+
+  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+     
+    ENDIF
+    
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
+                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_igen  
+
+  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_rgen  
+
+  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_lgen
+  
+
+
+  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+   
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+   
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+
+
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+            
+  END SUBROUTINE reduce_sum_mpi_igen
+  
+  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+
+    IMPLICIT NONE
+
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+ 
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+   
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE reduce_sum_mpi_rgen
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE grid1dTo2d_mpi_igen   
+
+
+  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_rgen   
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=.FALSE.
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_lgen   
+
+  
+
+
+  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_igen   
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+         VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_rgen   
+  
+
+  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_lgen   
+
+END MODULE mod_phys_lmdz_mpi_transfert
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,109 @@
+!
+!$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas $
+!
+MODULE mod_phys_lmdz_omp_data
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_using_omp
+  
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
+  
+  INTEGER,SAVE :: klon_omp
+  INTEGER,SAVE :: klon_omp_begin
+  INTEGER,SAVE :: klon_omp_end
+!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi)
+    USE dimphy
+    IMPLICIT NONE
+    INTEGER, INTENT(in) :: klon_mpi
+
+    INTEGER :: i
+
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
+#ifdef CPP_OMP    
+    INTEGER :: OMP_GET_NUM_THREADS
+    EXTERNAL OMP_GET_NUM_THREADS
+    INTEGER :: OMP_GET_THREAD_NUM
+    EXTERNAL OMP_GET_THREAD_NUM
+#endif  
+
+#ifdef CPP_OMP
+!$OMP MASTER
+        is_using_omp=.TRUE.
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+    is_using_omp=.FALSE.
+    omp_size=1
+    omp_rank=0
+#endif
+
+   is_omp_root=.FALSE.
+!$OMP MASTER
+   IF (omp_rank==0) THEN
+     is_omp_root=.TRUE.
+   ELSE
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
+   ENDIF
+!$OMP END MASTER
+
+
+!$OMP MASTER 
+    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
+    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
+    ALLOCATE(klon_omp_para_end(0:omp_size-1))
+    
+    DO i=0,omp_size-1
+      klon_omp_para_nb(i)=klon_mpi/omp_size
+      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
+    ENDDO
+    
+    klon_omp_para_begin(0) = 1
+    klon_omp_para_end(0) = klon_omp_para_nb(0)
+    
+    DO i=1,omp_size-1
+      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
+      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+   
+    klon_omp=klon_omp_para_nb(omp_rank)
+    klon_omp_begin=klon_omp_para_begin(omp_rank)
+    klon_omp_end=klon_omp_para_end(omp_rank)
+    
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_omp_data
+
+  SUBROUTINE Print_module_data
+  IMPLICIT NONE
+!  INCLUDE "iniprint.h"
+
+!$OMP CRITICAL  
+  WRITE(*,*)'--------> TASK ',omp_rank
+  WRITE(*,*)'omp_size =',omp_size
+  WRITE(*,*)'omp_rank =',omp_rank
+  WRITE(*,*)'is_omp_root =',is_omp_root
+  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(*,*)'klon_omp =',klon_omp
+  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(*,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1057 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_omp_transfert
+
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+		     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_omp
+    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+		     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+  
+  
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE scatter_omp_i
+
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
+    
+  END SUBROUTINE scatter_omp_i1
+  
+  
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
+
+  END SUBROUTINE scatter_omp_i2
+
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
+  
+  END SUBROUTINE scatter_omp_i3
+
+
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE scatter_omp_r
+
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
+        
+  END SUBROUTINE scatter_omp_r1
+  
+  
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
+
+  END SUBROUTINE scatter_omp_r2
+
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
+  
+  END SUBROUTINE scatter_omp_r3
+  
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE scatter_omp_l
+
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
+    
+  END SUBROUTINE scatter_omp_l1
+  
+  
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
+
+  END SUBROUTINE scatter_omp_l2
+
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
+  
+  END SUBROUTINE scatter_omp_l3  
+  
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
+    
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
+          
+  END SUBROUTINE gather_omp_i2
+  
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
+    
+  END SUBROUTINE gather_omp_i3
+
+
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+        
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    
+  END SUBROUTINE gather_omp_r2
+  
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))       
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
+    
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
+    
+  END SUBROUTINE gather_omp_l2
+  
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
+    
+  END SUBROUTINE gather_omp_l3
+
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+
+
+  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+    USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+ 
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+ 
+  END SUBROUTINE scatter_omp_igen
+
+
+  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_rgen
+
+
+  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+ !$OMP MASTER 
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_lgen
+
+
+
+
+
+  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_igen
+
+
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_lgen
+
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+END MODULE mod_phys_lmdz_omp_transfert
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,114 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_para
+  USE mod_phys_lmdz_transfert_para
+  USE mod_phys_lmdz_mpi_data
+  USE mod_phys_lmdz_omp_data
+    
+  INTEGER,SAVE :: klon_loc
+  LOGICAL,SAVE :: is_sequential
+  LOGICAL,SAVE :: is_parallel
+  LOGICAL,SAVE :: is_master
+  
+!$OMP THREADPRIVATE(klon_loc,is_master)
+  
+CONTAINS
+
+  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL Init_phys_lmdz_omp_data(klon_mpi)
+    klon_loc=klon_omp
+    IF (is_mpi_root .AND. is_omp_root) THEN 
+       is_master=.TRUE.
+     ELSE
+       is_master=.FALSE.
+     ENDIF
+     CALL Test_transfert
+!$OMP END PARALLEL    
+     IF (is_using_mpi .OR. is_using_omp) THEN
+       is_sequential=.FALSE.
+       is_parallel=.TRUE.
+     ELSE
+       is_sequential=.TRUE.
+       is_parallel=.FALSE.
+     ENDIF
+      
+  END SUBROUTINE Init_phys_lmdz_para
+
+  SUBROUTINE Test_transfert
+  USE mod_grid_phy_lmdz, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
+                               grid1dTo2d_glo, grid2dTo1d_glo
+  IMPLICIT NONE
+!    INCLUDE "iniprint.h"
+ 
+    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
+    REAL :: tmp1d_glo(klon_glo,nbp_lev)
+    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
+    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
+    REAL :: CheckSum
+    
+    INTEGER :: i,l
+  
+    Test_Field1d_glo = 0.
+    Test_Field2d_glo = 0.
+    Test_Field1d_loc = 0.
+    Test_Field2d_loc = 0.
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER
+      DO l=1,nbp_lev
+        DO i=1,klon_glo
+!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
+           Test_Field1d_glo(i,l)=1
+        ENDDO
+      ENDDO
+!$OMP END MASTER  
+    ENDIF
+  
+    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
+    CALL Gather(Test_Field1d_loc,tmp1d_glo)
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
+    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
+    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
+    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+
+    CALL bcast(Test_Field1d_glo)
+    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
+      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1275 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_transfert_para
+
+  USE mod_phys_lmdz_mpi_transfert
+  USE mod_phys_lmdz_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i
+
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i1
+  
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i2  
+
+
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i3
+  
+
+!!!!! --> Les reels
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r
+
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r1
+  
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r2  
+
+
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r3
+    
+    
+!!!!! --> Les booleens
+
+
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l
+
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l1
+  
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l2  
+
+
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i
+  
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i1
+
+  
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i2
+
+
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r
+  
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r1
+
+  
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r2
+
+
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r3
+  
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l
+  
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l1
+
+  
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l2
+
+
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l3
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_phys_lmdz_transfert_para
+
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/caldyn0.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/caldyn0.F
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/datareadnc.F	(revision 1403)
@@ -0,0 +1,309 @@
+c=======================================================================
+      SUBROUTINE datareadnc(relief,phisinit,alb,ith,z0,
+     &                    zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c
+c
+c   Author: F. Hourdin      01/1997
+c   -------
+c
+c   Object: To read data from Martian surface to use in a GCM
+c   ------                from NetCDF file "surface.nc"
+c
+c
+c   Arguments:
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c     Outputs:
+c     --------
+c
+c=======================================================================
+c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
+c
+c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
+c
+c   360 valeurs en longitude (de -179.5 a 179.5)
+c   180 valeurs en latitudes (de 89.5 a -89.5)
+c
+c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
+c
+c   Il faut donc que ces donnees soient au format grille scalaire
+c               (imold+1 jmold+1)
+c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
+c
+c   On prend imd (d pour donnees!) 
+c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
+c                   (rlonud de -179 a -181)
+c           jmd = 179 
+c                   (rlatvd de 89 a -89)
+c=======================================================================
+
+! to use  'getin'
+       use ioipsl_getincom 
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comconst.h"
+#include "netcdf.inc"
+#include "datafile.h"
+
+c=======================================================================
+c   Declarations:
+C=======================================================================
+
+      INTEGER    imd,jmd,imdp1,jmdp1
+      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
+
+      INTEGER    iimp1
+      parameter    (iimp1=iim+1-1/iim)
+
+! Arguments:
+      CHARACTER(len=3),intent(inout) :: relief
+      REAL,intent(out) :: phisinit(iimp1*jjp1)
+      REAL,intent(out) :: alb(iimp1*jjp1)
+      REAL,intent(out) :: ith(iimp1*jjp1)
+      REAL,intent(out) :: z0(iimp1*jjp1)
+      REAL,intent(out) :: zmea(imdp1*jmdp1)
+      REAL,intent(out) :: zstd(imdp1*jmdp1)
+      REAL,intent(out) :: zsig(imdp1*jmdp1)
+      REAL,intent(out) :: zgam(imdp1*jmdp1)
+      REAL,intent(out) :: zthe(imdp1*jmdp1)
+
+! Local variables:
+      REAL        zdata(imd*jmdp1)
+      REAL        zdataS(imdp1*jmdp1)
+      REAL        pfield(iimp1*jjp1)
+
+      INTEGER     ierr
+
+      INTEGER   unit,nvarid
+
+      INTEGER    i,j,k
+
+      INTEGER klatdat,ngridmxgdat
+      PARAMETER (klatdat=180,ngridmxgdat=360)
+
+c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
+
+      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
+      REAL rlonud(imdp1),rlatvd(jmd)
+
+      CHARACTER*20 string
+      DIMENSION string(0:4)
+
+
+!#include "lmdstd.h"
+#include "fxyprim.h"
+
+      pi=2.*ASIN(1.)
+
+c=======================================================================
+c    rlonud, rlatvd
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF des donnees latitude et longitude
+c-----------------------------------------------------------------------
+      write(*,*) 'datareadnc: opening file surface.nc'
+
+      datafile="/u/lmdz/WWW/planets/mars/datadir" ! default path to surface.nc
+      call getin("datadir",datafile) ! but users may specify another path
+      
+      ierr = NF_OPEN (trim(datafile)//'/surface.nc',
+     &  NF_NOWRITE,unit)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(*,*)'Error : cannot open file surface.nc '
+        write(*,*)'(in phymars/datareadnc.F)'
+        write(*,*)'It should be in :',trim(datafile),'/'
+        write(*,*)'1) You can set this path in the 
+     & callphys.def file:'
+        write(*,*)'   datadir=/path/to/the/datafiles'
+        write(*,*)'2) If necessary, surface.nc (and other datafiles)'
+        write(*,*)'   can be obtained online on:'
+        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
+        CALL ABORT
+      ENDIF
+
+c
+c Lecture des latitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
+#endif
+c
+c Lecture des longitudes (coordonnees):
+c
+      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
+#endif
+
+c-----------------------------------------------------------------------
+c    Passage au format boites scalaires
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c       longitude(imd)        -->      rlonud(imdp1) 
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do i=1,imd 
+          rlonud(i)=(longitude(i)+.5)*pi/180.
+      enddo
+
+c Repetition de la valeur im+1
+      rlonud(imdp1)=rlonud(1) + 2*pi
+
+c-----------------------------------------------------------------------
+c        latitude(jmdp1)         -->        rlonvd(jmd)
+c-----------------------------------------------------------------------
+
+c Passage en coordonnees boites scalaires et en radian
+      do j=1,jmd 
+          rlatvd(j)=(latitude(j)-.5)*pi/180.
+      enddo
+
+c=======================================================================
+c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
+c=======================================================================
+
+      string(0) = 'z0'
+      string(1) = 'albedo'
+      string(2) = 'thermal'
+      if (relief.ne.'pla') then
+        write(*,*) ' MOLA topography'
+        relief = 'MOL'
+          string(3) = 'z'//relief
+      else
+          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
+                            ! remise a 0 derriere
+      endif
+      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
+ 
+
+      DO k=0,4
+          write(*,*) 'string',k,string(k)
+          
+c-----------------------------------------------------------------------
+c    initialisation
+c-----------------------------------------------------------------------
+      call initial0(iimp1*jjp1,pfield)
+      call initial0(imd*jmdp1,zdata)
+      call initial0(imdp1*jmdp1,zdataS)
+
+c-----------------------------------------------------------------------
+c    Lecture NetCDF  
+c-----------------------------------------------------------------------
+
+      ierr = NF_INQ_VARID (unit, string(k), nvarid)
+      if (ierr.ne.nf_noerr) then
+        write(*,*) 'datareadnc error, cannot find ',trim(string(k))
+        write(*,*) ' in file ',trim(datafile),'/surface.nc'
+        stop
+      endif
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
+#else
+      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
+#endif
+      if (ierr.ne.nf_noerr) then
+        write(*,*) 'datareadnc: error failed loading ',trim(string(k))
+        stop
+      endif
+
+c-----------------------------------------------------------------------
+c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
+c-----------------------------------------------------------------------
+      if (k.eq.4) then
+
+          zdata(:)=1000.*zdata(:)
+          longitude(:)=(pi/180.)*longitude(:)
+          latitude(:)=(pi/180.)*latitude(:)
+
+          call grid_noro1(360, 180, longitude, latitude, zdata,
+     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
+
+          CALL dump2d(iip1,jjp1,zmea,'zmea')
+          CALL dump2d(iip1,jjp1,zstd,'zstd')
+          CALL dump2d(iip1,jjp1,zsig,'zsig')
+          CALL dump2d(iip1,jjp1,zgam,'zgam')
+          CALL dump2d(iip1,jjp1,zthe,'zthe')
+
+      endif
+
+c-----------------------------------------------------------------------
+c   Passage de zdata en grille (imdp1 jmdp1)
+c-----------------------------------------------------------------------
+      do j=1,jmdp1
+          do i=1,imd
+              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
+          enddo
+          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
+      enddo
+
+c-----------------------------------------------------------------------
+c    Interpolation
+c-----------------------------------------------------------------------
+      call interp_horiz(zdataS,pfield,imd,jmd,
+     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
+
+c-----------------------------------------------------------------------
+c    Periodicite    
+c-----------------------------------------------------------------------
+
+      do j=1,jjp1
+         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
+      enddo 
+ 
+c-----------------------------------------------------------------------
+c    Sauvegarde des champs    
+c-----------------------------------------------------------------------
+
+      if (k.eq.0) then                    ! z0
+         z0(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)*.01
+         ! multiplied by 0.01 to have z0 in m
+         CALL dump2d(iimp1,jjp1,z0,'z0 in m')
+      elseif (k.eq.1) then                    ! albedo
+         do i=1,iimp1*jjp1
+              alb(i) = pfield(i)
+          enddo
+      elseif (k.eq.2) then                ! thermal
+         do i=1,iimp1*jjp1
+              ith(i) = pfield(i)
+          enddo
+      elseif (k.eq.3) then                ! relief
+        if (relief.eq.'pla') then
+              call initial0(iimp1*jjp1,phisinit)
+        else
+             do i=1,iimp1*jjp1
+                  phisinit(i) = pfield(i)
+              enddo
+        endif
+      endif
+
+      ENDDO
+
+c-----------------------------------------------------------------------
+c    Traitement Phisinit
+c-----------------------------------------------------------------------
+
+      phisinit(1:iimp1*jjp1)=1000.*phisinit(1:iimp1*jjp1)
+      CALL dump2d(iimp1,jjp1,phisinit,'Altitude in m')
+      phisinit(:)=g*phisinit(:)
+
+c-----------------------------------------------------------------------
+c    FIN
+c-----------------------------------------------------------------------
+
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/defrun_new.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/defrun_new.F
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/exner_hyb.F	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/exner_hyb.F
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/grid_noro1.F	(revision 1403)
@@ -0,0 +1,423 @@
+      SUBROUTINE grid_noro1(imdep, jmdep, xdata, ydata, entree,
+     .                 imar, jmar, x, y, zmea,zstd,zsig,zgam,zthe)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Calcul des parametres de l'orographie sous-maille necessaires
+c      au nouveau shema de representation des montagnes meso-echelles
+c      dans le modele.  Les points sont mis sur une grille rectangulaire
+c      pseudo-physique.  Typiquement, il y a iim+1 latitudes incluant
+c      le pole nord et le pole sud.  Il y a jjm+1 longitudes, y compris
+c      aux poles.  Aux poles les champs peuvent ont une valeurs repetee
+c      jjm+1 fois.....  La valeur du champs en jjm+1 (jmar) est celle
+c      en j=1.  
+c      Les parametres a,b,c,d representent les limites de la region
+c      de point de grille correspondant a un point decrit precedemment.
+c      Les moyennes sur ces regions des valeurs calculees a partir de
+c      l'USN, sont ponderees par un poids, fonction de la surface
+c      occuppe par ces donnees a l'interieure de la grille du modele.
+c      Dans la plupart des cas ce poid est le rapport entre la surface
+c      de la region de point de grille USN et la surface de la region
+c      de point de grille du modele.
+c       
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X et Y pour depart
+c        xdata, ydata: coordonnees X et Y pour depart
+c        entree: champ d'entree a transformer
+c        dans ce programme, on assume que les donnees sont les altitudes
+c        de l'USNavy: imdep=iusn=2160, jmdep=jusn=1080.
+c OUTPUT:
+c        imar, jmar: dimensions X et Y d'arrivee
+c        x, y: coordonnees X et Y d'arrivee
+c        les champs de sorties sont sur une grille physique:
+c             zmea:  orographie moyenne
+c             zstd:  deviation standard de l'orographie sous-maille
+c             zsig:  pente de l'orographie sous-maille 
+c             zgam:  anisotropy de l'orographie sous maille
+c             zthe:  orientation de l'axe oriente dans la direction
+c                    de plus grande pente de l'orographie sous maille
+C=======================================================================
+c     IMPLICIT INTEGER (I,J)
+c     IMPLICIT REAL(X,Z) 
+       implicit none
+       integer iusn,jusn,iext
+       parameter(iusn=360,jusn=180,iext=40)
+c!-*-      include 'param1'
+c!-*-      include 'comcstfi.h'
+#include "dimensions.h"
+#include "comconst.h"
+c!-*-
+c!-*-      parameter(iim=cols,jjm=rows)
+      REAL xusn(iusn+2*iext),yusn(jusn+2)	
+      REAL zusn(iusn+2*iext,jusn+2),zusnfi(iusn+2*iext,jusn+2)
+
+c   modif declarations pour implicit none
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor
+      real zsigsud,zweinor,zweisud
+      real xk,xl,xm,xw,xp,xq
+      real zmaxmea,zmaxstd,zmaxsig,zmaxgam,zmaxthe,zminthe
+      real zbordnor,zbordsud,zbordest,zbordoue,xpi
+      real zdeltax,zdeltay,zlenx,zleny,weighx,weighy,xincr
+      integer i,j,ii,jj,ideltax,ihalph
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL entree(imdep,jmdep)
+c
+      INTEGER imar, jmar
+  
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
+      REAL zxtzyusn(iusn+2*iext,jusn+2)
+      REAL weight(iim+1,jjm+1)
+      REAL x(imar+1),y(jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+c  quelques constantes:
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+      print*,'rad =',rad
+      print*,'Long et lat entree'
+      print*,(x(i),i=1,imar+1)
+      print*,(y(j),j=1,jmar)
+       print*,'Long et lat donnees'
+      print*,(xdata(i),i=1,imdep)
+      print*,(ydata(j),j=1,jmdep)
+
+      xpi=acos(-1.)
+      zdeltay=2.*xpi/real(jusn)*rad
+c
+c  quelques tests de dimensions:
+c    
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar ou jmar trop grand', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
+         print *,' imdep ou jmdep mal dimensionnes:',imdep,jmdep
+         call abort
+      ENDIF
+
+      IF(imar+1.gt.iim+1.or.jmar.gt.jjm+1)THEN
+        print *,' imar ou jmar mal dimensionnes:',imar,jmar
+        call abort
+      ENDIF
+c
+C  Extension de la base de donnee de l'USN pour faciliter
+C  les calculs ulterieurs:
+c
+      DO j=1,jusn
+        yusn(j+1)=ydata(j)
+      DO i=1,iusn
+        zusn(i+iext,j+1)=entree(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=entree(iusn-iext+i,j)
+        xusn(i)=xdata(iusn-iext+i)-2.*xpi
+        zusn(iusn+iext+i,j+1)=entree(i,j)
+        xusn(iusn+iext+i)=xdata(i)+2.*xpi
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
+       DO i=1,iusn/2+iext
+        zusn(i,1)=zusn(i+iusn/2,2)
+        zusn(i+iusn/2+iext,1)=zusn(i,2)
+        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
+        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
+       ENDDO
+c
+c  Calcul d'une orographie filtree aux hautes latitudes
+c  pour permettre des calculs plus isotropiques sur la pente
+c  des montagnes
+c
+       DO i=1,IUSN+2*iext
+       DO J=1,JUSN+2
+          zusnfi(i,j)=0.0
+       ENDDO
+       ENDDO
+
+      DO j=1,jusn
+            ideltax=1./cos(yusn(j+1))
+            ideltax=min(iusn/2-1,ideltax)
+            IF(MOD(IDELTAX,2).EQ.0)THEN
+              IDELTAX=IDELTAX+1
+            ENDIF
+            IHALPH=(IDELTAX-1)/2 
+c           print *,' ideltax=',ideltax
+         IF(ideltax.eq.1)THEN
+            DO i=1,iusn
+               zusnfi(i+iext,j+1)=entree(i,j)
+            ENDDO   
+         ELSE
+            DO i=1,ihalph
+               DO ii=1,i+ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               DO ii=ihalph-i,0,-1
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(iusn-ii,j)
+               ENDDO  
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO   
+            DO i=iusn-ihalph+1,iusn
+               DO ii = i-ihalph,iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO 
+               DO ii = 1,ihalph+i-iusn
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO
+            DO i=ihalph+1,iusn-ihalph
+               DO ii=-ihalph,ihalph
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)+entree(i+ii,j)
+               ENDDO
+               zusnfi(i+iext,j+1)=zusnfi(i+iext,j+1)/real(ideltax)
+            ENDDO
+         ENDIF
+            DO i=1,iext
+               zusnfi(i,j+1)=zusnfi(iusn-iext+i,j+1)
+               zusnfi(i+iusn+iext,j+1)=zusnfi(i,j+1)
+            ENDDO
+      ENDDO
+c  
+c Calculer les limites des zones des nouveaux points
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar-1
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar) = b(imar-1)
+      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+c
+c      quelques initialisations:
+      print*,'OKM1'
+c
+      DO i = 1, imar
+      DO j = 1, jmar
+         weight(i,j) = 0.0
+         zxtzx(i,j) = 0.0
+         zytzy(i,j) = 0.0
+         zxtzy(i,j) = 0.0
+         ztz(i,j) = 0.0
+         zmea(i,j) = 0.0
+         zstd(i,j)=0.0
+      ENDDO
+      ENDDO
+c
+c  calculs des correlations de pentes sur la grille de l'USN.
+c
+         DO j = 2,jusn+1 
+         DO i = 1, iusn+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jusn+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, iusn+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusnfi(i+1,j)-zusnfi(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusnfi(i+1,j)-zusnfi(i-1,j))/zdeltax
+         ENDDO
+
+         ENDDO
+
+ 
+
+      print*,'OK0'
+c
+c  sommations des differentes quantites definies precedemment
+c  sur une grille du modele.
+c 
+      zleny=xpi/real(jusn)*rad
+      xincr=xpi/2./real(jusn)
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jusn+1 
+c         DO j = 3,jusn 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*rad
+            zbordsud=(yusn(j)-d(jj)+xincr)*rad
+            weighy=amax1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, iusn+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
+            weighx=amax1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  calculs des differents parametres necessaires au programme
+c  de parametrisation de l'orographie a l'echelle moyenne:
+c
+      zmaxmea=0.
+      zmaxstd=0.
+      zmaxsig=0.
+      zmaxgam=0.
+      zmaxthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       print*,'OK1'
+       DO ii = 1, imar
+       DO jj = 1, jmar
+c       print*,'ok0'
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Orography moyenne:
+c         print*,'ok1'
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c         print*,'ok2'
+c  Deviation standard:
+           zstd(ii,jj)=sqrt(amax1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c          print*,'ok3'
+c pente: 
+           zsig(ii,jj)=sqrt(xq)
+c           zsig(ii,jj)=sqrt(2.*xk)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+c          print*,'ok4'
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+c          print*,'ok1b'
+         ENDIF
+      zmaxmea=amax1(zmea(ii,jj),zmaxmea)
+c         print*,'oka'
+      zmaxstd=amax1(zstd(ii,jj),zmaxstd)
+c         print*,'okb'
+      zmaxsig=amax1(zsig(ii,jj),zmaxsig)
+c         print*,'okc'
+      zmaxgam=amax1(zgam(ii,jj),zmaxgam)
+c         print*,'okd'
+      zmaxthe=amax1(zthe(ii,jj),zmaxthe)
+c         print*,'oke'
+      zminthe=amin1(zthe(ii,jj),zminthe)
+c      print*,'ok5'
+       ENDDO
+       ENDDO
+
+      print *,'  MEAN ORO:',zmaxmea
+	  print *,'  ST. DEV.:',zmaxstd
+      print *,'  PENTE:',zmaxsig
+      print *,' ANISOTROP:',zmaxgam
+      print *,'  ANGLE:',zminthe,zmaxthe	
+      
+C
+c  On passe ce donnees sur la grille dite physique....(?)
+c  On met gamma et theta a 1. et 0. aux poles ou ces quantites
+c  n'ont pas vraiment de sens
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/ini_archive.F	(revision 1403)
@@ -0,0 +1,523 @@
+c=======================================================================
+      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:  ecriture de l'entete du fichier "start_archive"
+c   -----
+c
+c	 Proche de iniwrite.F
+c
+c	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
+c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
+c	 du RUN + ptotal et cotoicetotal)
+c
+c			tab_cntrl(50+l)=tab_cntrl_fi(l)
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       idayref        Valeur du jour initial a mettre dans
+c                      l'entete du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       ith            soil thermal inertia
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+ 
+      use comsoil_h, only: nsoilmx, mlayer
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL		tab_cntrl(length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      INTEGER*4	idayref
+      REAL		phis(ip1jmp1)
+      real ith(ip1jmp1,nsoilmx)
+      REAL		tab_cntrl_fi(length)
+
+!Mars --------Ajouts-----------
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3) !, dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llmp1,idim_llm
+      INTEGER idim_tim
+      INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID #
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)=0.
+      ENDDO
+
+ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+      tab_cntrl(1)  = REAL(iim) ! nombre de points en longitude
+      tab_cntrl(2)  = REAL(jjm) ! nombre de points en latitude
+      tab_cntrl(3)  = REAL(llm) ! nombre de couches
+      tab_cntrl(4)  = REAL(idayref) ! jour 0
+      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
+      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
+      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
+      tab_cntrl(8)  = cpp 
+      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
+      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
+      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
+      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
+      tab_cntrl(12) = etot0 ! energie totale    !
+      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
+      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
+      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
+      tab_cntrl(16) = ang0 ! moment cinetique  !
+      tab_cntrl(17) = pa
+      tab_cntrl(18) = preff
+
+c    .....    parametres  pour le zoom      ......   
+
+      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
+      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
+      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
+      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
+
+      IF ( fxyhypb )   THEN
+       tab_cntrl(23) = 1.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+      ELSE
+       tab_cntrl(23) = 0.
+       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
+       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
+       tab_cntrl(26) = 0.
+       IF ( ysinus)  tab_cntrl(26) = 1.
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   Copie du tableau des parametres de controle du RUN  (physique)
+c		dans le tableau dynamique
+c-----------------------------------------------------------------------
+
+      DO l=1,50
+         tab_cntrl(50+l)=tab_cntrl_fi(l)
+      ENDDO
+
+c=======================================================================
+c	Ecriture NetCDF de l''entete du fichier "start_archive"
+c=======================================================================
+
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 21,
+     &                       "Fichier start_archive")
+c
+c Definir les dimensions du fichiers:
+c
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
+
+      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
+
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c  Ecriture du tableau des parametres du run
+c-----------------------------------------------------------------------
+
+      call def_var(nid,"Time","Time","days since 00:00:00",1,
+     .            idim_tim,nvarid,ierr)
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des longitudes et latitudes
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des niveaux verticaux
+c-----------------------------------------------------------------------
+
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Coef A: niveaux pression hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
+     .                       "Coefficient B niveaux sigma hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
+     .      "Coef AS: hybrid pressure in midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
+     .      "Coef BS: hybrid sigma midlayers")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+#endif
+c
+c ----------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c ------------------------------------------------------------------
+c  Variable uniquement pour visualisation avec Grads ou Ferret
+c ------------------------------------------------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "North latitude")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
+#endif
+c----------------------
+       ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
+     .      "East longitude")
+      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
+#endif
+c--------------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
+     .       idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
+     .       idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
+
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
+#endif
+
+!-------------------------------
+! (soil) depth variable mlayer() (known from comsoil.h)
+!-------------------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     .                        "Soil mid-layer depth")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
+#endif
+
+!---------------------
+! soil thermal inertia
+!---------------------
+      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
+      dims3(1)=idim_rlonv
+      dims3(2)=idim_rlatu
+      dims3(3)=idim_nsoilmx
+      ! define variable
+#ifdef NC_DOUBLE
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
+     &                        "Soil thermal inertia")
+      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
+     &                        "J.s-1/2.m-2.K-1")
+      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
+      ! write variable
+#ifdef NC_DOUBLE
+      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
+#else
+      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture du geopentiel au sol
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+
+      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'rad,omeg,g,mugaz,kappa',
+     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
+      PRINT*,'daysec,dtvr',daysec,dtvr
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/iniphysiq.F90	(revision 1403)
@@ -0,0 +1,142 @@
+subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+
+use dimphy, only : klev ! number of atmospheric levels
+use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
+                                       ! (on full grid)
+use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
+                               klon_omp_begin, & ! start index of local omp subgrid
+                               klon_omp_end, & ! end index of local omp subgrid
+                               klon_mpi_begin ! start indes of columns (on local mpi grid)
+
+use comgeomphy, only : initcomgeomphy, &
+                       airephy, & ! physics grid area (m2)
+                       cuphy, & ! cu coeff. (u_covariant = cu * u)
+                       cvphy, & ! cv coeff. (v_covariant = cv * v)
+                       rlond, & ! longitudes
+                       rlatd ! latitudes
+use infotrac, only : nqtot ! number of advected tracers
+use comgeomfi_h, only: ini_fillgeom
+
+implicit none
+
+include "iniprint.h"
+
+real,intent(in) :: prad ! radius of the planet (m)
+real,intent(in) :: pg ! gravitational acceleration (m/s2)
+real,intent(in) :: pr ! ! reduced gas constant R/mu
+real,intent(in) :: pcpp ! specific heat Cp
+real,intent(in) :: punjours ! length (in s) of a standard day
+!integer,intent(in) :: ngrid ! number of horizontal grid points in the physics (full grid)
+integer,intent(in) :: nlayer ! number of atmospheric layers
+integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
+integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
+real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
+real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
+real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
+real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
+real,intent(in) :: cv((ii+1)*jj) ! cv coeff. (v_covariant = cv * v)
+integer,intent(in) :: pdayref ! reference day of for the simulation
+real,intent(in) :: ptimestep !physics time step (s)
+integer,intent(in) :: iflag_phys ! type of physics to be called
+
+integer :: ibegin,iend,offset
+integer :: i,j
+character(len=20) :: modname='iniphysiq'
+character(len=80) :: abort_message
+real :: total_area_phy, total_area_dyn
+
+
+! global array, on full physics grid:
+real,allocatable :: latfi(:)
+real,allocatable :: lonfi(:)
+real,allocatable :: cufi(:)
+real,allocatable :: cvfi(:)
+real,allocatable :: airefi(:)
+
+IF (nlayer.NE.klev) THEN
+  write(*,*) 'STOP in ',trim(modname)
+  write(*,*) 'Problem with dimensions :'
+  write(*,*) 'nlayer     = ',nlayer
+  write(*,*) 'klev   = ',klev
+  abort_message = ''
+  CALL abort_gcm (modname,abort_message,1)
+ENDIF
+
+!IF (ngrid.NE.klon_glo) THEN
+!  write(*,*) 'STOP in ',trim(modname)
+!  write(*,*) 'Problem with dimensions :'
+!  write(*,*) 'ngrid     = ',ngrid
+!  write(*,*) 'klon   = ',klon_glo
+!  abort_message = ''
+!  CALL abort_gcm (modname,abort_message,1)
+!ENDIF
+
+! Generate global arrays on full physics grid
+allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+latfi(1)=rlatu(1)
+lonfi(1)=0.
+cufi(1) = cu(1)
+cvfi(1) = cv(1)
+DO j=2,jj
+  DO i=1,ii
+    latfi((j-2)*ii+1+i)= rlatu(j)
+    lonfi((j-2)*ii+1+i)= rlonv(i)
+    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
+    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
+  ENDDO
+ENDDO
+latfi(klon_glo)= rlatu(jj+1)
+lonfi(klon_glo)= 0.
+cufi(klon_glo) = cu((ii+1)*jj+1)
+cvfi(klon_glo) = cv((ii+1)*jj-ii)
+
+! build airefi(), mesh area on physics grid
+allocate(airefi(klon_glo))
+CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
+! Poles are single points on physics grid
+airefi(1)=sum(aire(1:ii,1))
+airefi(klon_glo)=sum(aire(1:ii,jj+1))
+
+! Sanity check: do total planet area match between physics and dynamics?
+total_area_dyn=sum(aire(1:ii,1:jj+1))
+total_area_phy=sum(airefi(1:klon_glo))
+IF (total_area_dyn/=total_area_phy) THEN
+  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+    ! stop here if the relative difference is more than 0.001%
+    abort_message = 'planet total surface discrepancy'
+    CALL abort_gcm(modname, abort_message, 1)
+  ENDIF
+ENDIF
+
+
+
+!$OMP PARALLEL 
+! Now generate local lon/lat/cu/cv/area arrays
+call initcomgeomphy
+
+!!!!$OMP PARALLEL PRIVATE(ibegin,iend) 
+!!!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+offset=klon_mpi_begin-1
+airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
+cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
+cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+! copy some fundamental parameters to physics 
+! and do some initializations 
+call phys_state_var_init(klon_omp,nlayer,nqtot, &
+                         punjours,ptimestep,prad,pg,pr,pcpp)
+call ini_fillgeom(klon_omp,rlatd,rlond,airephy)
+call conf_phys(klon_omp,nlayer,nqtot)
+
+!$OMP END PARALLEL
+
+
+end subroutine iniphysiq
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/interp_vert.F	(revision 1403)
@@ -0,0 +1,70 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apso,bpso,
+     &             aps,bps,ps,Nhoriz)
+c
+c interpolation lineaire pour passer
+c a une nouvelle discretisation verticale pour
+c les variables de GCM
+c Francois Forget (01/1995)
+c Modif pour coordonnees hybrides FF (03/2003)
+c**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer (input)
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer) (input)
+
+       integer Nhoriz ! nombre de point horizontale (input)
+       real ps(nhoriz) !pression de surface (input)
+
+       real varo(Nhoriz,lmo) ! var dans l''ancienne grille (input)
+       real varn(Nhoriz,lmn) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       integer n, ln ,lo 
+       real coef
+       REAL sigmo(lmo) ! niveau sigma des variables dans les anciennes coord
+       REAL sigmn(lmn) ! niveau sigma des variables dans les nouvelles coord
+
+c run
+c ====
+
+      do n=1,Nhoriz
+        do ln=1,lmn
+            sigmn(ln)=aps(ln)/ps(n)+bps(ln)
+        end do
+        do lo=1,lmo
+            sigmo(lo)=apso(lo)/ps(n)+bpso(lo)
+        end do
+
+        do ln=1,lmn
+           if (sigmn(ln).ge.sigmo(1))then
+             varn(n,ln) =  varo(n,1)  
+           else if (sigmn(ln).le.sigmo(lmo)) then
+             varn(n,ln) =  varo(n,lmo)
+           else
+              do lo =1,lmo-1 
+                if ( (sigmn(ln).le.sigmo(lo)).and.
+     &             (sigmn(ln).gt.sigmo(lo+1)) )then
+                  coef = (sigmn(ln)-sigmo(lo))/(sigmo(lo+1)-sigmo(lo))
+                   varn(n,ln)=varo(n,lo) +coef*(varo(n,lo+1)-varo(n,lo))
+                end if
+              end do           
+           end if
+         end do
+
+      end do
+
+
+      return
+      end
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/lect_start_archive.F	(revision 1403)
@@ -0,0 +1,1432 @@
+      SUBROUTINE lect_start_archive(ngrid,nlayer,nqtot,
+     &     date,tsurf,tsoil,emis,q2,
+     &     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,
+     &     q,qsurf,tauscaling,surfith,nid)
+c=======================================================================
+c
+c
+c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
+c   ------
+c
+c
+c   Objet:     Lecture des variables d'un fichier "start_archive"
+c              Plus besoin de régler ancienne valeurs grace
+c              a l'allocation dynamique de memoire (Yann Wanherdrick)
+c
+c
+c
+c=======================================================================
+      use infotrac, only: tname
+      use comsoil_h, only: nsoilmx, layer, mlayer, volcapa, inertiedat
+      use planete_h
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "netcdf.inc"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+! routine arguments
+! -----------------
+      integer,intent(in) :: ngrid ! number of atmosphferic columns
+                                  ! on new physics grid
+      integer,intent(in) :: nlayer ! number of atmospheric layers
+                                   ! on new grid
+      integer,intent(in) :: nqtot ! number of advected tracers
+      REAL,INTENT(OUT) :: date
+      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
+      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
+      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
+      REAL,INTENT(OUT) :: co2ice(ngrid) ! CO2 ice layer
+      REAL,INTENT(OUT) :: emis(ngrid)
+      REAL,INTENT(OUT) :: q2(ngrid,nlayer+1),qsurf(ngrid,nqtot)
+      REAL,INTENT(OUT) :: tauscaling(ngrid) ! dust conversion factor
+      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
+      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
+      real,intent(in) :: surfith(iip1,jjp1) ! surface thermal inertia
+      INTEGER,INTENT(IN) :: nid ! input NetCDF file identifier
+
+
+
+c Old variables dimensions (from file)
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nsoilold,nqold
+
+c Variables pour les lectures des fichiers "ini" 
+c--------------------------------------------------
+!      INTEGER sizei,
+      integer timelen,dimid
+!      INTEGER length
+!      parameter (length = 100)
+      INTEGER tab0
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
+
+!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
+
+!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
+!      CHARACTER*120 dimsource
+!      CHARACTER*16 dimname
+!      CHARACTER*80 dimtitle
+!      CHARACTER*40 dimunits
+!      INTEGER   dimtype
+
+!      INTEGER dimord(4)  ! tableau contenant l''ordre
+!      data dimord /1,2,3,4/ ! de sortie des dimensions
+
+!      INTEGER vardim(4)
+      INTEGER   memo
+!      character (len=50) :: tmpname
+
+c Variable histoire 
+c------------------
+      REAL ::qtot(iip1,jjp1,llm)
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+
+c!-*-
+!      integer klatdat,klongdat
+!      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+
+c variable physique
+c------------------
+c     REAL phisfi(ngrid)
+
+      INTEGER i,j,l
+      INTEGER nvarid
+c     REAL year_day,periheli,aphelie,peri_day
+c     REAL obliquit,z0,emin_turb,lmixmin
+c     REAL emissiv,emisice(2),albedice(2),tauvis
+c     REAL iceradius(2) , dtemisice(2)
+
+!      EXTERNAL RAN1
+!      REAL RAN1
+!      EXTERNAL geopot,inigeom
+      integer ierr
+!      integer ismin
+!      external ismin
+!      CHARACTER*80 datapath
+      integer, dimension(4) :: start,count
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real inertiedatS(iip1,jjp1,nsoilmx)
+      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
+      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
+      real tauscalingS(iip1,jjp1)
+
+      real ptotal, co2icetotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:), allocatable :: timelist
+      real, dimension(:), allocatable :: rlonuold, rlatvold
+      real, dimension(:), allocatable :: rlonvold, rlatuold
+      real, dimension(:), allocatable :: apsold,bpsold
+      real, dimension(:), allocatable :: mlayerold
+      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
+      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
+      real, dimension(:,:,:),allocatable :: tsoiloldnew
+! tsoiloldnew: old soil values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatold
+! inertiedatoldnew: old inertia values, but along new subterranean grid
+      real, dimension(:,:,:), allocatable :: inertiedatoldnew
+      real, dimension(:,:), allocatable :: psold,phisold
+      real, dimension(:,:), allocatable :: co2iceold,tsurfold
+      real, dimension(:,:), allocatable :: emisold
+      real, dimension(:,:,:,:), allocatable :: qold
+      real, dimension(:,:), allocatable :: tauscalingold
+
+      real tab_cntrl(100)
+
+      real ptotalold, co2icetotalold
+
+      logical :: olddepthdef=.false. ! flag
+! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
+      logical :: depthinterpol=.false. ! flag
+! depthinterpol=.true. if interpolation will be requiered
+      logical :: therminertia_3D=.true. ! flag
+! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+      real, dimension(:), allocatable :: oldgrid, oldval
+      real, dimension(:), allocatable :: newval
+!      real, dimension(:), allocatable :: oldmlayer
+
+!      real surfithfi(ngrid)
+      ! surface thermal inertia at old horizontal grid resolution
+      real, dimension(:,:), allocatable :: surfithold 
+
+! flag which identifies if archive file is using old tracer names (qsurf01,...)
+      logical :: oldtracernames=.false.
+      integer :: counter
+      character(len=30) :: txt ! to store some text
+      real :: tmpval ! to store a temporary variable/value
+
+c=======================================================================
+
+! 0. Preliminary stuff
+
+! check if tracers follow old naming convention (q01, q02, q03, ...)
+      counter=0
+      do iq=1,nqtot
+        txt= " "
+        write(txt,'(a1,i2.2)')'q',iq
+        ierr=NF_INQ_VARID(nid,txt,nvarid)
+        if (ierr.ne.NF_NOERR) then
+          ! did not find old tracer name
+          exit ! might as well stop here
+        else
+          ! found old tracer name
+          counter=counter+1
+        endif
+      enddo
+      if (counter.eq.nqtot) then
+        write(*,*) "lect_start_archive: tracers seem to follow old ",
+     &             "naming convention (q01, q02,...)"
+        oldtracernames=.true.
+      endif
+
+
+!-----------------------------------------------------------------------
+! 1. Read data dimensions (i.e. size and length)
+!-----------------------------------------------------------------------
+
+! 1.2 Read the various dimension lengths of data in file 
+
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"temps",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find Time length'
+        stop
+      else
+        write(*,*) "lect_start_archive: timelen=",timelen
+      endif
+
+      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find lat length'
+        stop
+      else
+        write(*,*) "lect_start_archive: jmold=",jmold
+      endif
+      jmold=jmold-1
+
+      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find lon length'
+        stop
+      else
+        write(*,*) "lect_start_archive: imold=",imold
+      endif
+      imold=imold-1
+
+      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
+      if (ierr.ne.NF_NOERR) then
+         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
+      endif
+      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
+      if (ierr.ne.NF_NOERR) then
+        write(*,*) 'lect_start_archive error: cannot find alt length'
+        stop
+      else
+        write(*,*) "lect_start_archive: lmold=",lmold
+      endif
+
+      nqold=0
+      do
+         write(str2,'(i2.2)') nqold+1
+         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
+!        write(*,*) 'q'//str2
+         if (ierr.eq.NF_NOERR) then
+            nqold=nqold+1
+         else
+            exit
+         endif
+      enddo
+
+! 1.2.1 find out the # of subsurface_layers
+      nsoilold=0 !dummy initialisation
+      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
+      if (ierr.eq.NF_NOERR) then
+        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
+	if (ierr.ne.NF_NOERR) then
+	 write(*,*)'lec_start_archive: ',
+     &              'Failed reading subsurface_layers length'
+	endif
+      else
+        write(*,*)"lec_start_archive: did not find subsurface_layers"
+      endif
+
+      if (nsoilold.eq.0) then ! 'old' archive format;
+      ! must use Tg//str2 fields to compute nsoilold
+      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
+        do
+	 write(str2,'(i2.2)') nsoilold+1
+	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
+	 if (ierr.eq.NF_NOERR) then
+	  nsoilold=nsoilold+1
+	 else
+	  exit
+	 endif
+	enddo
+      endif
+
+
+      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
+        depthinterpol=.true.
+      endif
+
+! 1.3 Report dimensions
+      
+      write(*,*) "lect_start_archive: Start_archive dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      if (nqold.gt.0) then
+        write(*,*) "old tracers q*: ",nqold
+      endif
+      write(*,*) "subsurface_layers: ",nsoilold
+      if (depthinterpol) then
+      write(*,*) " => Warning, nsoilmx= ",nsoilmx
+      write(*,*) '    which implies that you want subterranean interpola
+     &tion.'
+      write(*,*) '  Otherwise, set nsoilmx -in comsoil_h- to: ',nsoilold
+      endif
+      write(*,*) "time lenght: ",timelen
+      write(*,*) 
+
+!-----------------------------------------------------------------------
+! 2. Allocate arrays to store datasets
+!-----------------------------------------------------------------------
+
+      allocate(timelist(timelen))
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate (apsold(lmold),bpsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(qold(imold+1,jmold+1,lmold,nqtot))
+      allocate(co2iceold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(emisold(imold+1,jmold+1))
+      allocate(q2old(imold+1,jmold+1,lmold+1))
+!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(tsoilold(imold+1,jmold+1,nsoilold))
+      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
+      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
+      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
+      ! surface thermal inertia at old horizontal grid resolution
+      allocate(surfithold(imold+1,jmold+1))
+      allocate(mlayerold(nsoilold))
+      allocate(qsurfold(imold+1,jmold+1,nqtot))
+      allocate(tauscalingold(imold+1,jmold+1))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      write(*,*) 'q2',ngrid,nlayer+1
+      write(*,*) 'q2S',iip1,jjp1,llm+1
+      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
+
+!-----------------------------------------------------------------------
+! 3. Read time-independent data
+!-----------------------------------------------------------------------
+
+C-----------------------------------------------------------------------
+c 3.1. Lecture du tableau des parametres du run 
+c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Lect_start_archive: <controle> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <controle>"
+         CALL abort
+      ENDIF
+c
+      tab0 = 50
+
+c-----------------------------------------------------------------------
+c 3.2 Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlonv> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlatu> is missing"
+         CALL abort
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlonu> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <rlatv> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+c-----------------------------------------------------------------------
+c 3.3. Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <aps> is missing"
+         apsold=0
+         PRINT*, "<aps> set to 0"
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: Failed loading <aps>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <bps> is missing"
+         PRINT*, "It must be an old start_archive, lets look for sig_s"
+         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "Nothing to do..."
+            CALL abort
+         ENDIF
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <bps>"
+         CALL abort
+      END IF
+
+c-----------------------------------------------------------------------
+c 3.4 Read Soil layers depths
+c-----------------------------------------------------------------------
+     
+      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <soildepth>'
+       write(*,*)' => Assuming this is an archive in old format'
+       olddepthdef=.true.
+       depthinterpol=.true.
+       ! this is how soil depth was defined in ye old days
+	do isoil=1,nsoilold
+	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
+	enddo
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+
+      endif !of if(ierr.ne.NF_NOERR)
+
+      ! Read (or build) mlayer()
+      if (depthinterpol) then
+       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
+       ! as in soil_settings.F
+       write(*,*)' => Building default soil depths'
+       do isoil=0,nsoilmx-1
+         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
+       enddo
+       write(*,*)' => mlayer: ',mlayer
+       ! Also build (default) new soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+       write(*,*)' =>  layer: ',layer
+      else ! read mlayer() from file
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <soildepth>"
+         CALL abort
+       endif
+       ! Also build (default) soil interlayer depth layer(:)
+       do isoil=1,nsoilmx
+         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
+     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
+       enddo
+      endif ! of if (depthinterpol)
+
+c-----------------------------------------------------------------------
+c 3.5 Read Soil thermal inertia
+c-----------------------------------------------------------------------
+
+      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+      if (ierr.ne.NF_NOERR) then
+       write(*,*)'lect_start_archive: Could not find <inertiedat>'
+       write(*,*)' => Assuming this is an archive in old format'
+       therminertia_3D=.false.
+       write(*,*)' => Thermal inertia will be read from reference file'
+       volcapa=1.e6
+       write(*,*)'    and soil volumetric heat capacity is set to ',
+     &           volcapa
+      else
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
+#else
+        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
+#endif
+       if (ierr .NE. NF_NOERR) then
+         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
+         CALL abort
+       endif
+      endif
+
+c-----------------------------------------------------------------------
+c 3.6 Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <phisinit> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <phisinit>"
+         CALL abort
+      ENDIF
+
+C-----------------------------------------------------------------------
+c   lecture de "ptotalold" et "co2icetotalold"
+c-----------------------------------------------------------------------
+      ptotalold = tab_cntrl(tab0+49)
+      co2icetotalold = tab_cntrl(tab0+50)
+ 
+c-----------------------------------------------------------------------
+c 4. Lecture du temps et choix
+c-----------------------------------------------------------------------
+ 
+c  lecture du temps
+c
+      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: <Time> is missing"
+            CALL abort
+         endif
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      endif 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <Time>"
+         CALL abort
+      ENDIF
+c
+      write(*,*)
+      write(*,*)
+      write(*,*) 'Dates of the stored initial states:'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      pi=2.*ASIN(1.)
+      do i=1,timelen
+c       call solarlong(timelist(i),sollong(i))
+c       sollong(i) = sollong(i)*180./pi
+c        write(*,*) 'initial state at martian day: ',int(timelist(i))
+        write(*,*) 'initial state at martian day: ',timelist(i)
+c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
+c    .    sollong(i)
+      end do
+
+   6  FORMAT(i7,i7,f9.3)
+ 
+      write(*,*)
+      write(*,*) 'Choose the martian day to use'
+ 123  read(*,*,iostat=ierr) date
+      if(ierr.ne.0) goto 123
+      memo = 0
+      do i=1,timelen
+c        if (date.eq.int(timelist(i))) then
+        if (abs(date-timelist(i)).lt.0.01) then
+            memo = i
+        endif
+      end do
+ 
+      if (memo.eq.0) then
+        write(*,*)
+        write(*,*)
+        write(*,*) 'Wrong value for day number !!'
+        write(*,*)
+        write(*,*) 'Dates of the stored initial states:'
+        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+        do i=1,timelen
+          write(*,*) 'initial state at martian day: ',timelist(i)
+c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
+        end do
+        goto 123
+      endif
+      
+!-----------------------------------------------------------------------
+! 5. Read (time-dependent) data from datafile
+!-----------------------------------------------------------------------
+
+
+c-----------------------------------------------------------------------
+c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf, tauscaling)
+c-----------------------------------------------------------------------
+ 
+      start=(/1,1,memo,0/)
+      count=(/imold+1,jmold+1,1,0/)
+       
+      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <co2ice> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <co2ice>"
+         PRINT*, NF_STRERROR(ierr)
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "emis", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <emis> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <emis>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <ps> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <tsurf> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <tsurf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <q2surf> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <q2surf>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tauscaling", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <tauscaling> not in file"
+         tauscalingold(:,:) = -1
+      ELSE
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tauscalingold)
+#else
+        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tauscalingold)
+#endif
+        IF (ierr .NE. NF_NOERR) THEN
+           PRINT*, "lect_start_archive: Failed loading <tauscaling>"
+           PRINT*, NF_STRERROR(ierr)
+           CALL abort
+        ENDIF
+      ENDIF
+c
+      write(*,*)"lect_start_archive: rlonuold:"
+     &           ,rlonuold," rlatvold:",rlatvold
+      write(*,*)
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Surface tracers:      
+      qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0
+
+      DO iq=1,nqtot
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a5,i2.2)')'qsurf',iq
+        ELSE
+          txt=trim(tname(iq))//"_surf"
+          if (txt.eq."h2o_vap") then
+            ! There is no surface tracer for h2o_vap;
+            ! "h2o_ice" should be loaded instead
+            txt="h2o_ice_surf"
+            write(*,*) 'lect_start_archive: loading surface tracer',
+     &                     ' h2o_ice instead of h2o_vap'
+          endif
+        ENDIF ! of IF (oldtracernames)
+        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+          print*, "which (constant) value should it be initialized to?"
+          read(*,*) tmpval
+          qsurfold(1:imold+1,1:jmold+1,iq)=tmpval
+        ELSE ! tracer exists in file, load it
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          qsurfold(1,1,iq))
+#endif
+          IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &             " Failed loading <",trim(txt),">"
+            stop
+          ENDIF
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+!-----------------------------------------------------------------------
+! 5.2 Read 3D subterranean fields
+!-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+!
+! Read soil temperatures
+!
+      if (olddepthdef) then ! tsoil stored using the 'old format'
+         start=(/1,1,memo,0/)
+         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
+       do isoil=1,nsoilold
+!        write(*,*)'isoil',isoil
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              "Field <","Tg"//str2,"> not found"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
+     &          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &            "Failed reading <","Tg"//str2,">"
+            CALL abort
+         ENDIF
+c
+       enddo ! of do isoil=1,nsoilold
+      
+      ! reset 'start' and 'count' to "3D" behaviour
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,nsoilold,1/)
+      
+      else
+       write(*,*) "lect_start_archive: loading tsoil "
+       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
+       if (ierr.ne.NF_NOERR) then
+        write(*,*)"lect_start_archive: Cannot find <tsoil>"
+	call abort
+       else
+#ifdef NC_DOUBLE
+      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
+#else
+      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
+#endif
+       endif ! of if (ierr.ne.NF_NOERR)
+       
+      endif ! of if (olddepthdef)
+
+!
+! Read soil thermal inertias
+!
+!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
+!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
+!       if (ierr.ne.NF_NOERR) then
+!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
+!	call abort
+!       else
+!#ifdef NC_DOUBLE
+!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
+!#else
+!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
+!#endif
+!       endif ! of if (ierr.ne.NF_NOERR)
+!      endif
+
+c-----------------------------------------------------------------------
+c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,memo/)
+      count=(/imold+1,jmold+1,lmold,1/)
+
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <temp> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <u> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <v> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <v>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: <q2atm> is missing"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Failed loading <q2atm>"
+         CALL abort
+      ENDIF
+c
+
+c tracers: the 2 last ones are kept the 2 last one. 
+c the others keep their rank. ! No longer true.
+c -------------------------------------------
+! Tracers:
+      qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0
+
+      DO iq=1,nqtot
+        IF (oldtracernames) THEN
+          txt=" "
+          write(txt,'(a1,i2.2)')'q',iq
+        ELSE
+          txt=tname(iq)
+        ENDIF
+        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
+        ierr = NF_INQ_VARID (nid,txt,nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &              " Tracer <",trim(txt),"> not found"
+          print*, "which (constant) value should it be initialized to?"
+          read(*,*) tmpval
+          qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval
+        ELSE ! tracer exists in file, load it
+#ifdef NC_DOUBLE
+         ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
+#else
+         ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
+#endif
+          IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: ",
+     &             "  Failed loading <",trim(txt),">"
+            stop
+          ENDIF
+        ENDIF
+
+      ENDDO ! of DO iq=1,nqtot
+
+
+c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
+c -------------------------------------------------------------------------
+
+!      datapath = '/users/forget/gcm/data_mars_gcm'
+
+
+!=======================================================================
+! 6. Interpolation from old grid to new grid
+!=======================================================================
+
+c=======================================================================
+c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
+c=======================================================================
+c  Interpolation horizontale puis passage dans la grille physique pour 
+c  les variables physique 
+c  Interpolation verticale puis horizontale pour chaque variable 3D
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c 6.1	Variable 2d :
+c-----------------------------------------------------------------------
+c Relief 
+      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Glace CO2
+      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tsurfs,tsurf)
+c     write(44,*) 'tsurf', tsurf
+
+c Temperature du sous-sol
+!      call interp_horiz(tsoilold,tsoils,
+!     &                  imold,jmold,iim,jjm,nsoilmx,
+!     &                   rlonuold,rlatvold,rlonu,rlatv)
+!      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoils,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+c Emissivite de la surface
+      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
+
+c Dust conversion factor
+      call interp_horiz (tauscalingold,tauscalings,imold,jmold,iim,jjm,
+     &                   1,rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tauscalings,tauscaling)
+c     write(46,*) 'emis',emis
+c-----------------------------------------------------------------------
+c 6.1.2	Traitement special de la pression au sol :
+c-----------------------------------------------------------------------
+
+c  Extrapolation la pression dans la nouvelle grille
+      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c-----------------------------------------------------------------------
+c	On assure la conservation de la masse de l'atmosphere + calottes
+c-----------------------------------------------------------------------
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
+         END DO
+      END DO
+
+      write(*,*)
+      write(*,*)'Old grid: mass of the atmosphere :',ptotalold
+      write(*,*)'New grid: mass of the atmosphere :',ptotal
+      write (*,*) 'Ratio new atm / old atm =', ptotal/ptotalold 
+      write(*,*)
+      write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold
+      write(*,*)'New grid: mass of CO2 ice:',co2icetotal
+      if (co2icetotalold.ne.0.) then
+       write(*,*)'Ratio new ice / old ice =',co2icetotal/co2icetotalold
+      endif
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+      if ( co2icetotalold.gt.0.) then 
+         DO j=1,jjp1
+            DO i=1,iip1
+               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
+            END DO
+         END DO
+      end if
+
+c-----------------------------------------------------------------------
+c 6.2 Subterranean 3d variables:
+c-----------------------------------------------------------------------
+
+c-----------------------------------------------------------------------
+c 6.2.1 Thermal Inertia
+c       Note: recall that inertiedat is a common in "comsoil.h"
+c-----------------------------------------------------------------------
+
+      ! depth-wise interpolation, if required
+      if (depthinterpol.and.(.not.olddepthdef)) then
+        allocate(oldval(nsoilold))
+	allocate(newval(nsoilmx))
+        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
+     &f soil thermal inertia; might be wiser to reset it.'
+        write(*,*)
+       
+        do i=1,imold+1
+         do j=1,jmold+1
+	   !copy old values
+	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
+	   !interpolate
+	   call interp_line(mlayerold,oldval,nsoilold,
+     &                     mlayer,newval,nsoilmx)
+           !copy interpolated values
+           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+        enddo
+        ! cleanup
+	deallocate(oldval)
+	deallocate(newval)
+      endif !of if (depthinterpol)
+
+      if (therminertia_3D) then
+        ! We have inertiedatold
+       if((imold.ne.iim).or.(jmold.ne.jjm)) then
+       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
+     &of thermal inertia; might be better to reset it.'
+       write(*,*)
+       endif
+       
+        ! Do horizontal interpolation
+	if (depthinterpol) then
+	  call interp_horiz(inertiedatoldnew,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+	else
+          call interp_horiz(inertiedatold,inertiedatS,
+     &                  imold,jmold,iim,jjm,nsoilold,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+        endif ! of if (depthinterpol)
+
+      else ! no 3D thermal inertia data
+       write(*,*)'lect_start_archive: using reference surface inertia'
+        ! Use surface inertia (and extend it to all depths)
+        do i=1,nsoilmx
+         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
+        enddo
+	! Build an old resolution surface thermal inertia
+	! (will be needed for tsoil interpolation)
+	call interp_horiz(surfith,surfithold,
+     &                    iim,jjm,imold,jmold,1,
+     &                    rlonu,rlatv,rlonuold,rlatvold)
+      endif
+
+
+      ! Reshape inertiedatS to scalar grid as inertiedat
+      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
+     &                  inertiedatS,inertiedat)
+      
+c-----------------------------------------------------------------------
+c 6.2.2 Soil temperature
+c-----------------------------------------------------------------------
+!      write(*,*) 'Soil'
+      ! Recast temperatures along soil depth, if necessary
+      if (olddepthdef) then
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	   ! build vertical coordinate
+	   oldgrid(1)=0. ! ground
+	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
+     &                (surfithold(i,j)/1.e6)
+          ! Note; at this stage, we impose volcapa=1.e6 above
+	  ! since volcapa isn't set in old soil definitions
+
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+
+      else
+       if (depthinterpol) then ! if vertical interpolation is required
+        allocate(oldgrid(nsoilold+1))
+        allocate(oldval(nsoilold+1))
+	allocate(newval(nsoilmx))
+        ! build vertical coordinate
+	oldgrid(1)=0. ! ground
+	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
+        do i=1,imold+1
+	 do j=1,jmold+1
+	   ! copy values
+	   oldval(1)=tsurfold(i,j)
+	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
+	  ! interpolate
+	  call interp_line(oldgrid,oldval,nsoilold+1,
+     &                     mlayer,newval,nsoilmx)
+	 ! copy result in tsoilold
+	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
+	 enddo
+	enddo
+!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
+        ! cleanup
+	deallocate(oldgrid)
+	deallocate(oldval)
+	deallocate(newval)
+       
+       else
+        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
+       endif ! of if (depthinterpol)
+      endif ! of if (olddepthdef)
+
+      ! Do the horizontal interpolation
+       call interp_horiz(tsoiloldnew,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+      ! Reshape tsoilS to scalar grid as tsoil
+       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
+
+
+
+c-----------------------------------------------------------------------
+c 6.3 Variable 3d :
+c-----------------------------------------------------------------------
+      
+c temperatures atmospheriques
+      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
+
+c q2 : pbl wind variance
+      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
+      call interp_vert (q2old,varp1,lmold+1,llm+1,
+     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
+      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
+      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
+      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
+c     write(47,*) 'q2',q2
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call scal_wind(us,vs,unat,vnat)
+      write (*,*) 'lect_start_archive: unat ', unat (1,1,1)    ! INFO
+      do l=1,llm
+        do j = 1, jjp1
+          do i=1,iip1
+            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
+c           ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'lect_start_archive: ucov ', ucov (1,1,1)  ! INFO
+c     write(48,*) 'ucov',ucov
+      do l=1,llm
+        do j = 1, jjm
+          do i=1,iim
+            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
+c           vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+c traceurs surface
+      do iq = 1, nqtot
+            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
+     &                  imold,jmold,iim,jjm,1,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
+
+c traceurs 3D
+      do  iq = 1, nqtot
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+cccccccccccccccccccccccccccccc      
+c  make sure that sum of q = 1      
+c dominent species is = 1 - sum(all other species)      
+cccccccccccccccccccccccccccccc      
+c      iqmax=1
+c      
+c      if (nqold.gt.10) then
+c       do l=1,llm
+c        do j=1,jjp1
+c          do i=1,iip1
+c           do iq=1,nqold
+c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
+c              iqmax=iq
+c            endif
+c           enddo
+c           q(i,j,l,iqmax)=1.
+c           qtot(i,j,l)=0
+c           do iq=1,nqold
+c            if (iq.ne.iqmax) then        
+c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
+c            endif
+c           enddo !iq
+c           do iq=1,nqold
+c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
+c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
+c     $    qtot(i,j,l)
+c           enddo !iq
+c          enddo !i   
+c         enddo !j   
+c       enddo !l  
+c      endif
+ccccccccccccccccccccccccccccccc
+
+c     Periodicite :
+      do  iq = 1, nqtot
+         do l=1, llm
+            do j = 1, jjp1
+               q(iip1,j,l,iq) = q(1,j,l,iq)
+            end do
+         end do
+      enddo
+      
+      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
+
+c-----------------------------------------------------------------------
+c   Initialisation  h:	(passage de t -> h)
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO j=1,jjp1
+            DO i=1,iim
+               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
+            END DO
+            h(iip1,j,l) =  h(1,j,l)
+         END DO
+      END DO
+
+
+c***********************************************************************
+c***********************************************************************
+c     Fin subroutine lecture ini
+c***********************************************************************
+c***********************************************************************
+
+      deallocate(timelist)
+      deallocate(rlonuold, rlatvold)
+      deallocate(rlonvold, rlatuold)
+      deallocate(apsold,bpsold)
+      deallocate(uold)
+      deallocate(vold)
+      deallocate(told)
+      deallocate(psold)
+      deallocate(phisold)
+      deallocate(qold)
+      deallocate(co2iceold)
+      deallocate(tsurfold)
+      deallocate(emisold)
+      deallocate(q2old)
+      deallocate(tsoilold)
+      deallocate(tsoiloldnew)
+      deallocate(inertiedatold)
+      deallocate(inertiedatoldnew)
+      deallocate(surfithold)
+      deallocate(mlayerold)
+      deallocate(qsurfold)
+      deallocate(tauscalingold)
+      deallocate(var,varp1)
+
+!      write(*,*)'lect_start_archive: END'
+      return
+      end
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/newstart.F	(revision 1403)
@@ -0,0 +1,1781 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
+c   ------
+c             Derniere modif : 12/03
+c
+c
+c   Objet:  Create or modify the initial state for the LMD Mars GCM
+c   -----           (fichiers NetCDF start et startfi)
+c
+c
+c=======================================================================
+
+      use ioipsl_getincom, only: getin 
+      use infotrac, only: iniadvtrac, nqtot, tname
+      use tracer_mod, only: noms, mmol,
+     &                      igcm_dust_number, igcm_dust_mass,
+     &                      igcm_ccn_number, igcm_ccn_mass,
+     &                      igcm_h2o_vap, igcm_h2o_ice, igcm_co2,
+     &                      igcm_n2, igcm_ar, igcm_o2, igcm_co
+      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
+     &                     albedodat, z0_default, qsurf, tsurf,
+     &                     co2ice, emis
+      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx, tsoil
+      use control_mod, only: day_step, iphysiq, anneeref
+      use phyredem, only: physdem0, physdem1
+      use iostart, only: open_startphy
+      use comgeomphy, only: initcomgeomphy
+!      use planete_h
+      use dimradmars_mod, only: tauscaling
+      use turb_mod, only: q2
+      use comgeomfi_h, only: ini_fillgeom
+      use filtreg_mod, only: inifilr
+
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "description.h"
+#include "ener.h"
+#include "temps.h"
+#include "comdissnew.h"
+#include "clesph0.h"
+#include "serre.h"
+#include "netcdf.inc"
+#include "datafile.h"
+c=======================================================================
+c   Declarations
+c=======================================================================
+
+c Variables dimension du fichier "start_archive"
+c------------------------------------
+      CHARACTER	relief*3
+
+c et autres:
+c----------
+
+c Variables pour les lectures NetCDF des fichiers "start_archive" 
+c--------------------------------------------------
+      INTEGER nid_dyn, nid_fi,nid,nvarid
+      INTEGER tab0
+
+      REAL  date
+      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL phis(iip1,jjp1)
+      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
+
+c autre variables dynamique nouvelle grille
+c------------------------------------------
+      REAL pks(iip1,jjp1)
+      REAL w(iip1,jjp1,llm+1)
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
+!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
+      REAL phi(iip1,jjp1,llm)
+
+      integer klatdat,klongdat
+      PARAMETER (klatdat=180,klongdat=360)
+
+c Physique sur grille scalaire 
+c----------------------------
+      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
+      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
+      real z0S(iip1,jjp1)
+
+c variable physique
+c------------------
+      REAL tauscadyn(iip1,jjp1) ! dust conversion factor on the dynamics grid
+      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
+      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
+      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
+      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
+
+      INTEGER i,j,l,isoil,ig,idum
+      real mugaz ! molar mass of the atmosphere
+
+      integer ierr  !, nbetat
+
+c Variables on the new grid along scalar points 
+c------------------------------------------------------
+!      REAL p(iip1,jjp1)
+      REAL t(iip1,jjp1,llm)
+      real phisold_newgrid(iip1,jjp1)
+      REAL :: teta(iip1, jjp1, llm)
+      REAL :: pk(iip1,jjp1,llm)
+      REAL :: pkf(iip1,jjp1,llm)
+      REAL :: ps(iip1, jjp1)
+      REAL :: masse(iip1,jjp1,llm)
+      REAL :: xpn,xps,xppn(iim),xpps(iim)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: beta(iip1,jjp1,llm)
+!      REAL dteta(ip1jmp1,llm)
+
+c Variable de l'ancienne grille 
+c------------------------------
+      real time
+      real tab_cntrl(100)
+      real tab_cntrl_bis(100)
+
+c variables diverses
+c-------------------
+      real choix_1 ! ==0 : read start_archive file ; ==1: read start files
+      character*80      fichnom
+      integer Lmodif,iq
+      integer flagthermo, flagh2o
+      character modif*20
+      real tsud,albsud,alb_bb,ith_bb,Tiso
+      real ptoto,pcap,patm,airetot,ptotn,patmn
+!      real ssum
+      character*1 yes
+      logical :: flagiso=.false. ,  flagps0=.false.
+      real val, val2, val3 ! to store temporary variables
+      real :: iceith=2000 ! thermal inertia of subterranean ice
+      real :: iceithN,iceithS ! values of thermal inertias in N & S hemispheres
+      integer iref,jref
+
+      INTEGER :: itau
+      
+      INTEGER :: numvanle
+      character(len=50) :: txt ! to store some text
+      integer :: count
+      real :: profile(llm+1) ! to store an atmospheric profile + surface value
+
+! MONS data:
+      real :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! coefficient to apply to convert d21 to 'true' depth (m)
+      real :: MONS_coeff
+      real :: MONS_coeffS ! coeff for southern hemisphere
+      real :: MONS_coeffN ! coeff for northern hemisphere
+!      real,parameter :: icedepthmin=1.e-3 ! Ice begins at most at that depth
+! Reference position for composition
+      real :: latref,lonref,dlatmin,dlonmin
+! Variable used to change composition
+      real :: Svmr,Smmr,Smmr_old,Smmr_new,Sn
+      real :: Mair_old,Mair_new,vmr_old,vmr_new
+      real,allocatable :: coefvmr(:)  ! Correction coefficient when changing composition
+      integer :: iloc(1), iqmax
+
+c sortie visu pour les champs dynamiques
+c---------------------------------------
+!      INTEGER :: visuid
+!      real :: time_step,t_ops,t_wrt
+!      CHARACTER*80 :: visu_file
+
+      cpp    = 744.499 ! for Mars, instead of 1004.70885 (Earth)
+      preff  = 610.    ! for Mars, instead of 101325. (Earth)
+      pa= 20           ! for Mars, instead of 500 (Earth)
+
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+! allocate arrays
+      allocate(q(iip1,jjp1,llm,nqtot))
+      allocate(coefvmr(nqtot))
+
+c=======================================================================
+c   Choice of the start file(s) to use
+c=======================================================================
+
+      write(*,*) 'From which kind of files do you want to create new',
+     .  'start and startfi files'
+      write(*,*) '    0 - from a file start_archive'
+      write(*,*) '    1 - from files start and startfi'
+ 
+c-----------------------------------------------------------------------
+c   Open file(s) to modify (start or start_archive)
+c-----------------------------------------------------------------------
+
+      DO
+         read(*,*,iostat=ierr) choix_1
+         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
+      ENDDO
+
+c     Open start_archive
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+        tab0 = 50 
+        Lmodif = 1
+
+c     OR open start and startfi files
+c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      else
+        write(*,*) 'Creating start files from:'
+        write(*,*) './start.nc and ./startfi.nc'
+        write(*,*)
+        fichnom = 'start.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+        fichnom = 'startfi.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Problem opening file:',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+
+        tab0 = 0 
+        Lmodif = 0
+
+      endif
+
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'reading tab_cntrl START_ARCHIVE'
+c
+        ierr = NF_INQ_VARID (nid, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+c
+      else if (choix_1.eq.1) then
+
+        write(*,*) 'reading tab_cntrl START'
+c
+        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
+#endif
+c
+        write(*,*) 'reading tab_cntrl STARTFI'
+c
+        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
+#else
+        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
+#endif
+c
+        do i=1,50
+          tab_cntrl(i+50)=tab_cntrl_bis(i)
+        enddo
+      write(*,*) 'printing tab_cntrl', tab_cntrl
+      do i=1,100
+        write(*,*) i,tab_cntrl(i)
+      enddo
+      
+      endif
+c-----------------------------------------------------------------------
+c		Initialisation des constantes dynamique
+c-----------------------------------------------------------------------
+
+      kappa = tab_cntrl(9) 
+      etot0 = tab_cntrl(12)
+      ptot0 = tab_cntrl(13)
+      ztot0 = tab_cntrl(14)
+      stot0 = tab_cntrl(15)
+      ang0 = tab_cntrl(16)
+      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
+      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
+
+c-----------------------------------------------------------------------
+c   Lecture du tab_cntrl et initialisation des constantes physiques
+c  - pour start:  Lmodif = 0 => pas de modifications possibles
+c                  (modif dans le tabfi de readfi + loin)
+c  - pour start_archive:  Lmodif = 1 => modifications possibles
+c-----------------------------------------------------------------------
+      if (choix_1.eq.0) then
+         ! tabfi requires that input file be first opened by open_startphy(fichnom)
+         fichnom = 'start_archive.nc'
+         call open_startphy(fichnom)
+         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      else if (choix_1.eq.1) then
+         fichnom = 'startfi.nc'
+         call open_startphy(fichnom)
+         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
+     .            p_omeg,p_g,p_mugaz,p_daysec,time)
+      endif
+
+      rad = p_rad
+      omeg = p_omeg
+      g = p_g
+      mugaz = p_mugaz
+      daysec = p_daysec
+!      write(*,*) 'aire',aire
+
+
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+      day_step=180 !?! Note: day_step is a common in "control.h"
+      CALL defrun_new( 99, .TRUE. )
+      CALL iniconst 
+      CALL inigeom
+      idum=-1
+      idum=0
+
+c Initialisation coordonnees /aires
+c -------------------------------
+! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
+!       rlatu() and rlonv() are given in radians
+      latfi(1)=rlatu(1)
+      lonfi(1)=0.
+      DO j=2,jjm
+         DO i=1,iim
+            latfi((j-2)*iim+1+i)=rlatu(j)
+            lonfi((j-2)*iim+1+i)=rlonv(i)
+         ENDDO
+      ENDDO
+      latfi(ngridmx)=rlatu(jjp1)
+      lonfi(ngridmx)=0.
+      
+      ! build airefi(), mesh area on physics grid
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+      ! Poles are single points on physics grid
+      airefi(1)=sum(aire(1:iim,1))
+      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
+
+! also initialize various physics flags/settings which might be needed
+!    (for instance initracer needs to know about some flags, and/or
+!      'datafile' path may be changed by user)
+      call phys_state_var_init(ngridmx,llm,nqtot,
+     .                         daysec,dtphys,rad,g,r,cpp)
+      call ini_fillgeom(ngridmx,latfi,lonfi,airefi)
+      call conf_phys(ngridmx,llm,nqtot)
+
+c=======================================================================
+c   lecture topographie, albedo, inertie thermique, relief sous-maille
+c=======================================================================
+
+      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
+                              ! surface.dat dans le cas des start
+
+c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
+c       write(*,*)
+c       write(*,*) 'choix du relief (mola,pla)'
+c       write(*,*) '(Topographie MGS MOLA, plat)'
+c       read(*,fmt='(a3)') relief
+        relief="mola"
+c     enddo
+
+      CALL datareadnc(relief,phis,alb,surfith,z0S,
+     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
+
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+!      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,z0S,z0)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
+      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
+
+      endif ! of if (choix_1.ne.1)
+
+
+c=======================================================================
+c  Lecture des fichiers (start ou start_archive)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+
+        write(*,*) 'Reading file START_ARCHIVE'
+        CALL lect_start_archive(ngridmx,llm,nqtot,
+     &   date,tsurf,tsoil,emis,q2,
+     &   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,
+     &   tauscaling,surfith,nid)
+        write(*,*) "OK, read start_archive file"
+	! copy soil thermal inertia
+	ithfi(:,:)=inertiedat(:,:)
+	
+        ierr= NF_CLOSE(nid)
+
+      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
+                                  !  permet de changer les valeurs du 
+                                  !  tab_cntrl Lmodif=1
+        tab0=0
+        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
+        write(*,*) 'Reading file START'
+        fichnom = 'start.nc'
+        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,time)
+
+        write(*,*) 'Reading file STARTFI'
+        fichnom = 'startfi.nc'
+        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
+     .        day_ini,time,
+     .        tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
+        
+        ! copy albedo and soil thermal inertia
+        do i=1,ngridmx
+          albfi(i) = albedodat(i)
+	  do j=1,nsoilmx
+           ithfi(i,j) = inertiedat(i,j)
+	  enddo
+        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
+        ! be neede later on if reinitializing soil thermal inertia
+          surfithfi(i)=ithfi(i,1)
+        enddo
+
+      else 
+        CALL exit(1)
+      endif
+
+      dtvr   = daysec/REAL(day_step)
+      dtphys   = dtvr * REAL(iphysiq)
+
+c=======================================================================
+c 
+c=======================================================================
+! If tracer names follow 'old' convention (q01, q02, ...) then
+! rename them
+      count=0
+      do iq=1,nqtot
+        txt=" "
+        write(txt,'(a1,i2.2)') 'q',iq
+        if (txt.eq.tname(iq)) then
+          count=count+1
+        endif
+      enddo ! of do iq=1,nqtot
+      
+      ! initialize tracer names noms(:) and indexes (igcm_co2, igcm_h2o_vap, ...)
+      call initracer(ngridmx,nqtot,qsurf)
+      
+      if (count.eq.nqtot) then
+        write(*,*) 'Newstart: updating tracer names'
+        ! copy noms(:) to tname(:) to have matching tracer names in physics
+        ! and dynamics
+        tname(1:nqtot)=noms(1:nqtot)
+      endif
+
+c=======================================================================
+c 
+c=======================================================================
+
+      do ! infinite loop on list of changes
+
+      write(*,*)
+      write(*,*)
+      write(*,*) 'List of possible changes :'
+      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~'
+      write(*,*)
+      write(*,*) 'flat         : no topography ("aquaplanet")'
+      write(*,*) 'bilball      : uniform albedo and thermal inertia'
+      write(*,*) 'z0           : set a uniform surface roughness length'
+      write(*,*) 'coldspole    : cold subsurface and high albedo at
+     $ S.Pole'
+      write(*,*) 'qname        : change tracer name'
+      write(*,*) 'q=0          : ALL tracer =zero'
+      write(*,*) 'q=x          : give a specific uniform value to one
+     $ tracer'
+      write(*,*) 'q=profile    : specify a profile for a tracer'
+      write(*,*) 'freedust     : rescale dust to a true value'
+      write(*,*) 'ini_q        : tracers initialization for chemistry
+     $ and water vapour'
+      write(*,*) 'ini_q-h2o    : tracers initialization for chemistry
+     $ only'
+      write(*,*) 'composition  : change atm main composition: CO2,N2,Ar,
+     $ O2,CO'
+      write(*,*) 'ini_h2osurf  : reinitialize surface water ice '
+      write(*,*) 'noglacier    : Remove tropical H2O ice if |lat|<45'
+      write(*,*) 'watercapn    : H20 ice on permanent N polar cap '
+      write(*,*) 'watercaps    : H20 ice on permanent S polar cap '
+      write(*,*) 'wetstart     : start with a wet atmosphere'
+      write(*,*) 'isotherm     : Isothermal Temperatures, wind set to
+     $ zero'
+      write(*,*) 'co2ice=0     : remove CO2 polar cap'
+      write(*,*) 'ptot         : change total pressure'
+      write(*,*) 'therm_ini_s  : set soil thermal inertia to reference
+     $ surface values'
+      write(*,*) 'subsoilice_n : put deep underground ice layer in
+     $ northern hemisphere'
+      write(*,*) 'subsoilice_s : put deep underground ice layer in
+     $ southern hemisphere'
+      write(*,*) 'mons_ice     : put underground ice layer according
+     $ to MONS derived data'
+
+        write(*,*)
+        write(*,*) 'Change to perform ?'
+        write(*,*) '   (enter keyword or return to end)'
+        write(*,*)
+
+        read(*,fmt='(a20)') modif
+        if (modif(1:1) .eq. ' ') exit ! exit loop on changes
+
+        write(*,*)
+        write(*,*) trim(modif) , ' : '
+
+c       'flat : no topography ("aquaplanet")'
+c       -------------------------------------
+        if (trim(modif) .eq. 'flat') then
+c         set topo to zero 
+          phis(:,:)=0
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
+          write(*,*) 'topography set to zero.'
+          write(*,*) 'WARNING : the subgrid topography parameters',
+     &    ' were not set to zero ! => set calllott to F'                    
+
+c        Choice for surface pressure
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to choose homogeneous surface',
+     &                 'pressure (y) or let newstart interpolate ',
+     &                 ' the previous field  (n)?'
+             read(*,fmt='(a)') yes
+         end do
+         if (yes.eq.'y') then
+           flagps0=.true.
+           write(*,*) 'New value for ps (Pa) ?'
+ 201       read(*,*,iostat=ierr) patm
+            if(ierr.ne.0) goto 201
+             write(*,*)
+             write(*,*) ' new ps everywhere (Pa) = ', patm
+             write(*,*)
+             do j=1,jjp1
+               do i=1,iip1
+                 ps(i,j)=patm
+               enddo
+             enddo
+         end if
+
+c       bilball : albedo, inertie thermique uniforme
+c       --------------------------------------------
+        else if (trim(modif) .eq. 'bilball') then
+          write(*,*) 'constante albedo and iner.therm:'
+          write(*,*) 'New value for albedo (ex: 0.25) ?'
+ 101      read(*,*,iostat=ierr) alb_bb
+          if(ierr.ne.0) goto 101
+          write(*,*)
+          write(*,*) ' uniform albedo (new value):',alb_bb
+          write(*,*)
+
+          write(*,*) 'New value for thermal inertia (eg: 247) ?'
+ 102      read(*,*,iostat=ierr) ith_bb
+          if(ierr.ne.0) goto 102
+          write(*,*) 'uniform thermal inertia (new value):',ith_bb
+          DO j=1,jjp1
+             DO i=1,iip1
+                alb(i,j) = alb_bb	! albedo
+		do isoil=1,nsoilmx
+                  ith(i,j,isoil) = ith_bb	! thermal inertia
+		enddo
+             END DO
+          END DO
+!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+        
+         ! also reset surface roughness length to default value
+         write(*,*) 'surface roughness length set to:',z0_default,' m'
+         z0(:)=z0_default
+
+!       z0 : set surface roughness length to a constant value
+!       -----------------------------------------------------
+        else if (trim(modif) .eq. 'z0') then
+          write(*,*) 'set a uniform surface roughness length'
+          write(*,*) ' value for z0_default (ex: ',z0_default,')?'
+          ierr=1
+          do while (ierr.ne.0)
+            read(*,*,iostat=ierr) z0_default
+          enddo
+          z0(:)=z0_default
+
+c       coldspole : sous-sol de la calotte sud toujours froid
+c       -----------------------------------------------------
+        else if (trim(modif) .eq. 'coldspole') then
+          write(*,*)'new value for the subsurface temperature',
+     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
+ 103      read(*,*,iostat=ierr) tsud
+          if(ierr.ne.0) goto 103
+          write(*,*)
+          write(*,*) ' new value of the subsurface temperature:',tsud
+c         nouvelle temperature sous la calotte permanente
+          do l=2,nsoilmx
+               tsoil(ngridmx,l) =  tsud
+          end do
+
+
+          write(*,*)'new value for the albedo',
+     &   'of the permanent southern polar cap ? (eg: 0.75)'
+ 104      read(*,*,iostat=ierr) albsud
+          if(ierr.ne.0) goto 104
+          write(*,*)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c         Option 1:  only the albedo of the pole is modified :    
+          albfi(ngridmx)=albsud
+          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
+     &    albfi(ngridmx)
+
+c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
+c           DO j=1,jjp1
+c             DO i=1,iip1
+c                ig=1+(j-2)*iim +i
+c                if(j.eq.1) ig=1
+c                if(j.eq.jjp1) ig=ngridmx
+c                if ((rlatu(j)*180./pi.lt.-84.).and.
+c     &            (rlatu(j)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.gt.-91.).and.
+c     &            (rlonv(i)*180./pi.lt.0.))         then
+cc    albedo de la calotte permanente fixe a albsud
+c                   alb(i,j)=albsud
+c                   write(*,*) 'lat=',rlatu(j)*180./pi,
+c     &                      ' lon=',rlonv(i)*180./pi
+cc     fin de la condition sur les limites de la calotte permanente
+c                end if
+c             ENDDO
+c          ENDDO
+c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
+
+
+c       ptot : Modification of the total pressure: ice + current atmosphere 
+c       -------------------------------------------------------------------
+        else if (trim(modif) .eq. 'ptot') then
+
+c         calcul de la pression totale glace + atm actuelle
+          patm=0.
+          airetot=0.
+          pcap=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                ig=1+(j-2)*iim +i
+                if(j.eq.1) ig=1
+                if(j.eq.jjp1) ig=ngridmx
+                patm = patm + ps(i,j)*aire(i,j)
+                airetot= airetot + aire(i,j)
+                pcap = pcap + aire(i,j)*co2ice(ig)*g
+             ENDDO
+          ENDDO
+          ptoto = pcap + patm
+
+          print*,'Current total pressure at surface (co2 ice + atm) ',
+     &       ptoto/airetot
+
+          print*,'new value?'
+          read(*,*) ptotn
+          ptotn=ptotn*airetot
+          patmn=ptotn-pcap
+          print*,'ptoto,patm,ptotn,patmn'
+          print*,ptoto,patm,ptotn,patmn
+          print*,'Mult. factor for pressure (atm only)', patmn/patm
+          do j=1,jjp1
+             do i=1,iip1
+                ps(i,j)=ps(i,j)*patmn/patm
+             enddo
+          enddo
+
+c        Correction pour la conservation des traceurs
+         yes=' '
+         do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*) 'Do you wish to conserve tracer total mass (y)',
+     &              ' or tracer mixing ratio (n) ?'
+             read(*,fmt='(a)') yes
+         end do
+
+         if (yes.eq.'y') then
+           write(*,*) 'OK : conservation of tracer total mass'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+          else
+            write(*,*) 'OK : conservation of tracer mixing ratio'
+          end if
+
+c       qname : change tracer name
+c       --------------------------
+        else if (trim(modif).eq.'qname') then
+         yes='y'
+         do while (yes.eq.'y')
+          write(*,*) 'Which tracer name do you want to change ?'
+          do iq=1,nqtot
+            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
+          enddo
+          write(*,'(a35,i3)')
+     &            '(enter tracer number; between 1 and ',nqtot
+          write(*,*)' or any other value to quit this option)'
+          read(*,*) iq
+          if ((iq.ge.1).and.(iq.le.nqtot)) then
+            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
+            read(*,*) txt
+            tname(iq)=txt
+            write(*,*)'Do you want to change another tracer name (y/n)?'
+            read(*,'(a)') yes 
+          else
+! inapropiate value of iq; quit this option
+            yes='n'
+          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
+         enddo ! of do while (yes.ne.'y')
+
+c       q=0 : set tracers to zero
+c       -------------------------
+        else if (trim(modif) .eq. 'q=0') then
+c          mise a 0 des q (traceurs)
+          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
+           DO iq =1, nqtot
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=1.e-30
+                  ENDDO
+               ENDDO
+             ENDDO
+           ENDDO
+
+c          set surface tracers to zero
+           DO iq =1, nqtot
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=0.
+             ENDDO
+           ENDDO
+
+c       q=x : initialise tracer manually 
+c       --------------------------------
+        else if (trim(modif) .eq. 'q=x') then
+             write(*,*) 'Which tracer do you want to modify ?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
+     &                 ' ? (kg/kg)'
+             read(*,*) val
+             DO l=1,llm
+               DO j=1,jjp1
+                  DO i=1,iip1
+                    q(i,j,l,iq)=val
+                  ENDDO
+               ENDDO
+             ENDDO
+             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
+     &                   ' ? (kg/m2)'
+             read(*,*) val
+             DO ig=1,ngridmx
+                 qsurf(ig,iq)=val
+             ENDDO
+
+c       q=profile : initialize tracer with a given profile
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'q=profile') then
+             write(*,*) 'Tracer profile will be sought in ASCII file'
+             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
+             write(*,*) "(one value per line in file; starting with"
+             write(*,*) "surface value, the 1st atmospheric layer"
+             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
+             write(*,*) 'Which tracer do you want to set?'
+             do iq=1,nqtot
+               write(*,*)iq,' : ',trim(tname(iq))
+             enddo
+             write(*,*) '(choose between 1 and ',nqtot,')'
+             read(*,*) iq 
+             if ((iq.lt.1).or.(iq.gt.nqtot)) then
+               ! wrong value for iq, go back to menu
+               write(*,*) "wrong input value:",iq
+               cycle
+             endif
+             ! look for input file 'profile_tracer'
+             txt="profile_"//trim(tname(iq))
+             open(41,file=trim(txt),status='old',form='formatted',
+     &            iostat=ierr)
+             if (ierr.eq.0) then
+               ! OK, found file 'profile_...', load the profile
+               do l=1,llm+1
+                 read(41,*,iostat=ierr) profile(l)
+                 if (ierr.ne.0) then ! something went wrong
+                   exit ! quit loop
+                 endif
+               enddo
+               if (ierr.eq.0) then
+                 ! initialize tracer values
+                 qsurf(:,iq)=profile(1)
+                 do l=1,llm
+                   q(:,:,l,iq)=profile(l+1)
+                 enddo
+                 write(*,*)'OK, tracer ',trim(tname(iq)),
+     &               ' initialized ','using values from file ',trim(txt)
+               else
+                 write(*,*)'problem reading file ',trim(txt),' !'
+                 write(*,*)'No modifications to tracer ',trim(tname(iq))
+               endif
+             else
+               write(*,*)'Could not find file ',trim(txt),' !'
+               write(*,*)'No modifications to tracer ',trim(tname(iq))
+             endif
+             
+c       convert dust from virtual to true values
+c       --------------------------------------------------
+        else if (trim(modif) .eq. 'freedust') then
+         if (minval(tauscaling) .lt. 0) then
+           write(*,*) 'WARNING conversion factor negative'
+           write(*,*) 'This is probably because it was not present
+     &in the file'
+           write(*,*) 'A constant conversion is used instead.'
+           tauscaling(:) = 1.e-3
+         endif
+         CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscadyn)
+          do l=1,llm
+            do j=1,jjp1
+              do i=1,iip1
+                if (igcm_dust_number .ne. 0) 
+     &            q(i,j,l,igcm_dust_number) =
+     &            q(i,j,l,igcm_dust_number) * tauscadyn(i,j)
+                if (igcm_dust_mass .ne. 0) 
+     &            q(i,j,l,igcm_dust_mass) =
+     &            q(i,j,l,igcm_dust_mass) * tauscadyn(i,j)
+                if (igcm_ccn_number .ne. 0) 
+     &            q(i,j,l,igcm_ccn_number) =
+     &            q(i,j,l,igcm_ccn_number) * tauscadyn(i,j)
+                if (igcm_ccn_mass .ne. 0) 
+     &            q(i,j,l,igcm_ccn_mass) =
+     &            q(i,j,l,igcm_ccn_mass) * tauscadyn(i,j)
+              end do
+            end do
+          end do
+
+          tauscaling(:) = 1.
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'done rescaling to true vale'
+
+c       ini_q : Initialize tracers for chemistry
+c       -----------------------------------------------
+        else if (trim(modif) .eq. 'ini_q') then
+          flagh2o    = 1
+          flagthermo = 0
+          yes=' '
+c         For more than 32 layers, possible to initiate thermosphere only     
+          if (llm.gt.32) then 
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &     'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then
+            flagthermo=1 
+            else
+            flagthermo=0
+            endif
+            enddo  
+          endif
+          
+          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
+     &                          flagh2o, flagthermo)
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'inichim_newstart: chemical species and
+     $ water vapour initialised'
+
+c       ini_q-h2o : as above except for the water vapour tracer 
+c       ------------------------------------------------------
+        else if (trim(modif) .eq. 'ini_q-h2o') then
+          flagh2o    = 0
+          flagthermo = 0
+          yes=' '
+          ! for more than 32 layers, possible to initiate thermosphere only     
+          if(llm.gt.32) then
+            do while ((yes.ne.'y').and.(yes.ne.'n'))
+            write(*,*)'',
+     &      'initialisation for thermosphere only? (y/n)'
+            read(*,fmt='(a)') yes
+            if (yes.eq.'y') then 
+            flagthermo=1 
+            else
+            flagthermo=0
+            endif
+            enddo
+          endif
+
+          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
+     &                          flagh2o, flagthermo)
+
+         ! We want to have the very same value at lon -180 and lon 180
+          do l = 1,llm
+             do j = 1,jjp1
+                do iq = 1,nqtot
+                   q(iip1,j,l,iq) = q(1,j,l,iq)
+                end do
+             end do
+          end do
+
+          write(*,*) 'inichim_newstart: chemical species initialised
+     $ (except water vapour)'
+
+c      composition : change main composition: CO2,N2,Ar,O2,CO (FF 03/2014)
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'composition') then
+          write(*,*) "Lat (degN)  lon (degE) of the reference site ?"
+          write(*,*) "e.g. MSL : -4.5  137.  "
+ 301      read(*,*,iostat=ierr) latref, lonref
+          if(ierr.ne.0) goto 301
+
+
+        !  Select GCM point close to reference site
+          dlonmin =90.
+          DO i=1,iip1-1
+             if (abs(rlonv(i)*180./pi -lonref).lt.dlonmin)then
+                iref=i
+                dlonmin=abs(rlonv(i)*180./pi -lonref)
+             end if   
+          ENDDO
+          dlatmin =45.
+          DO j=1,jjp1
+             if (abs(rlatu(j)*180./pi -latref).lt.dlatmin)then
+                jref=j
+                dlatmin=abs(rlatu(j)*180./pi -latref)
+             end if   
+          ENDDO
+          write(*,*) "In GCM : lat= " ,  rlatu(jref)*180./pi
+          write(*,*) "In GCM : lon= " ,  rlonv(iref)*180./pi
+          write(*,*)
+
+        ! Compute air molar mass at reference site
+          Smmr=0
+          Sn = 0
+          do iq=1,nqtot 
+             if ((iq.eq.igcm_co2).or.(iq.eq.igcm_n2)
+     &      .or. (iq.eq.igcm_ar).or.(iq.eq.igcm_o2)
+     &      .or. (iq.eq.igcm_co)) then
+                 Smmr=Smmr+q(iref,jref,1,iq)
+                 Sn=Sn+q(iref,jref,1,iq)/mmol(iq) 
+             end if
+          end do
+          write(*,*) "At reference site :  "
+          write(*,*) "Sum of mass mix. ratio (should be about 1)=",Smmr
+          Mair_old =Smmr/Sn
+          write(*,*)
+     &     "Air molar mass (g/mol) at reference site= ",Mair_old
+
+        ! Ask for new volume mixing ratio at reference site
+          Svmr =0.
+          Sn =0.
+          do iq=1,nqtot 
+           coefvmr(iq) = 1.
+           if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &     .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+
+             vmr_old=q(iref,jref,1,iq)*Mair_old/mmol(iq)  
+             write(*,*) "Previous vmr("//trim(tname(iq))//")= ", vmr_old
+
+              if (iq.eq.igcm_n2) then
+                write(*,*) "New vmr(n2)? (MSL: 2.03e-02 at Ls~184)"
+              endif
+              if (iq.eq.igcm_ar) then
+                write(*,*) "New vmr(ar)? (MSL: 2.07e-02 at Ls~184)"
+              endif
+              if (iq.eq.igcm_o2) then
+                write(*,*) "New vmr(o2)? (MSL: 1.73e-03 at Ls~184)"
+              endif
+              if (iq.eq.igcm_co) then
+                write(*,*) "New vmr(co)? (MSL: 7.49e-04 at Ls~184)"
+              endif
+ 302          read(*,*,iostat=ierr) vmr_new
+              if(ierr.ne.0) goto 302
+              write(*,*) "New vmr("//trim(tname(iq))//")= ",vmr_new
+              write(*,*) 
+              coefvmr(iq) = vmr_new/vmr_old
+              Svmr=Svmr+vmr_new
+              Sn=Sn+vmr_new*mmol(iq)
+           end if
+          enddo ! of do iq=1,nqtot 
+      !  Estimation of new Air molar mass at reference site (assuming vmr_co2 = 1-Svmr)
+          Mair_new = Sn + (1-Svmr)*mmol(igcm_co2) 
+          write(*,*)
+     &     "NEW Air molar mass (g/mol) at reference site= ",Mair_new
+
+        ! Compute mass mixing ratio changes  
+          do iq=1,nqtot  
+            if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &          .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+             write(*,*) "Everywhere mmr("//trim(tname(iq))//
+     &        ") is multiplied by ",coefvmr(iq)*Mair_old/Mair_new
+            end if
+          end do
+
+        ! Recompute mass mixing ratios everywhere, and adjust mmr of most abundant species
+        ! to keep sum of mmr constant.
+          do l=1,llm
+           do j=1,jjp1
+            do i=1,iip1
+              Smmr_old = 0.
+              Smmr_new = 0.
+              do iq=1,nqtot  
+                if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
+     &         .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
+                   Smmr_old = Smmr_old + q(i,j,l,iq) ! sum of old mmr 
+                   q(i,j,l,iq)=q(i,j,l,iq)*coefvmr(iq)*Mair_old/Mair_new
+                   Smmr_new = Smmr_new + q(i,j,l,iq) ! sum of new mmr
+                end if 
+              enddo
+              iloc = maxloc(q(i,j,l,:))
+              iqmax = iloc(1)
+              q(i,j,l,iqmax) = q(i,j,l,iqmax) + Smmr_old - Smmr_new
+            enddo
+           enddo
+          enddo
+
+          write(*,*)
+     &   "The most abundant species is modified everywhere to keep "//
+     &   "sum of mmr constant"
+          write(*,*) 'At reference site vmr(CO2)=', 
+     &        q(iref,jref,1,igcm_co2)*Mair_new/mmol(igcm_co2)
+          write(*,*) "Compared to MSL observation: vmr(CO2)= 0.957 "//
+     &   "at Ls=184" 
+
+c      wetstart : wet atmosphere with a north to south gradient
+c      --------------------------------------------------------
+       else if (trim(modif) .eq. 'wetstart') then
+        ! check that there is indeed a water vapor tracer
+        if (igcm_h2o_vap.eq.0) then
+          write(*,*) "No water vapour tracer! Can't use this option"
+          stop
+        endif
+          DO l=1,llm
+            DO j=1,jjp1
+              DO i=1,iip1-1
+                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
+              ENDDO
+              ! We want to have the very same value at lon -180 and lon 180
+              q(iip1,j,l,igcm_h2o_vap) = q(1,j,l,igcm_h2o_vap)
+            ENDDO
+          ENDDO
+
+         write(*,*) 'Water mass mixing ratio at north pole='
+     *               ,q(1,1,1,igcm_h2o_vap)
+         write(*,*) '---------------------------south pole='
+     *               ,q(1,jjp1,1,igcm_h2o_vap)
+
+c      ini_h2osurf : reinitialize surface water ice
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'ini_h2osurf') then
+          write(*,*)'max surface ice left?(e.g. 0.2 kg/m2=200microns)'
+ 207      read(*,*,iostat=ierr) val
+          if(ierr.ne.0) goto 207
+          write(*,*)'also set negative values of surf ice to 0'
+           do ig=1,ngridmx
+              qsurf(ig,igcm_h2o_ice)=min(val,qsurf(ig,igcm_h2o_ice))
+              qsurf(ig,igcm_h2o_ice)=max(0.,qsurf(ig,igcm_h2o_ice))
+           end do
+
+c      noglacier : remove tropical water ice (to initialize high res sim)
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'noglacier') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              write(*,*) 'OK: remove surface ice for |lat|<45'
+              if (abs(rlatu(j)*180./pi).lt.45.) then
+                   qsurf(ig,igcm_h2o_ice)=0.
+              end if
+           end do
+
+
+c      watercapn : H20 ice on permanent northern cap
+c      --------------------------------------------------
+        else if (trim(modif) .eq. 'watercapn') then
+           do ig=1,ngridmx
+             j=(ig-2)/iim +2
+              if(ig.eq.1) j=1
+              if (rlatu(j)*180./pi.gt.80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
+     &              rlatv(j)*180./pi
+                end if
+           enddo
+
+c      watercaps : H20 ice on permanent southern cap
+c      -------------------------------------------------
+        else if (trim(modif) .eq. 'watercaps') then
+           do ig=1,ngridmx
+               j=(ig-2)/iim +2
+               if(ig.eq.1) j=1
+               if (rlatu(j)*180./pi.lt.-80.) then
+                   qsurf(ig,igcm_h2o_ice)=1.e5
+                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
+     &              qsurf(ig,igcm_h2o_ice)
+                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
+     &              rlatv(j-1)*180./pi
+               end if
+           enddo
+
+c       isotherm : Isothermal temperatures and no winds
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'isotherm') then
+
+          write(*,*)'Isothermal temperature of the atmosphere, 
+     &           surface and subsurface'
+          write(*,*) 'Value of this temperature ? :'
+ 203      read(*,*,iostat=ierr) Tiso
+          if(ierr.ne.0) goto 203
+
+          do ig=1, ngridmx
+            tsurf(ig) = Tiso
+          end do
+          do l=2,nsoilmx
+            do ig=1, ngridmx
+              tsoil(ig,l) = Tiso
+            end do
+          end do
+          flagiso=.true.
+          call initial0(llm*ip1jmp1,ucov)
+          call initial0(llm*ip1jm,vcov)
+          call initial0(ngridmx*(llm+1),q2)
+
+c       co2ice=0 : remove CO2 polar ice caps'
+c       ------------------------------------------------
+        else if (trim(modif) .eq. 'co2ice=0') then
+           do ig=1,ngridmx
+              co2ice(ig)=0
+              emis(ig)=emis(ngridmx/2)
+           end do
+        
+!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
+!       ----------------------------------------------------------------------
+
+	else if (trim(modif).eq.'therm_ini_s') then
+!          write(*,*)"surfithfi(1):",surfithfi(1)
+	  do isoil=1,nsoilmx
+	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+	  enddo
+          write(*,*)'OK: Soil thermal inertia has been reset to referenc
+     &e surface values'
+!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
+	  ithfi(:,:)=inertiedat(:,:)
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+!       subsoilice_n: Put deep ice layer in northern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (trim(modif).eq.'subsoilice_n') then
+
+         write(*,*)'From which latitude (in deg.), up to the north pole,
+     &should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.lt.0.).or.(val.gt.90)) then
+	      write(*,*)'Latitude should be between 0 and 90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+!	 if (val2.lt.layer(1)) then
+!	  iref=1
+!	 else
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+!	 endif
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+!	 write(*,*)'layer',layer
+!	 write(*,*)'mlayer',mlayer
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=1,jref
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=1,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+!         do i=1,nsoilmx
+!	  write(*,*)'i:',i,'ithfi(1,i):',ithfi(1,i)
+!	 enddo
+
+	
+!       subsoilice_s: Put deep ice layer in southern hemisphere soil
+!       ------------------------------------------------------------
+
+	else if (trim(modif).eq.'subsoilice_s') then
+
+         write(*,*)'From which latitude (in deg.), down to the south pol
+     &e, should we put subterranean ice?'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val
+	  if (ierr.eq.0) then ! got a value
+	    ! do a sanity check
+	    if((val.gt.0.).or.(val.lt.-90)) then
+	      write(*,*)'Latitude should be between 0 and -90 deg. !!!'
+	      ierr=1
+	    else ! find corresponding jref (nearest latitude)
+	      ! note: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+	      do j=1,jjp1
+	        if ((rlatu(j)*180./pi.ge.val).and.
+     &              (rlatu(j+1)*180./pi.le.val)) then
+		  ! find which grid point is nearest to val:
+		  if (abs(rlatu(j)*180./pi-val).le.
+     &                abs((rlatu(j+1)*180./pi-val))) then
+		   jref=j
+		  else
+		   jref=j+1
+		  endif
+		 
+		 write(*,*)'Will use nearest grid latitude which is:',
+     &                     rlatu(jref)*180./pi
+		endif
+	      enddo ! of do j=1,jjp1
+	    endif ! of if((val.lt.0.).or.(val.gt.90))
+	  endif !of if (ierr.eq.0)
+	 enddo ! of do while
+
+         ! Build layers() (as in soil_settings.F)
+	 val2=sqrt(mlayer(0)*mlayer(1))
+	 val3=mlayer(1)/mlayer(0)
+	 do isoil=1,nsoilmx
+	   layer(isoil)=val2*(val3**(isoil-1))
+	 enddo
+
+         write(*,*)'At which depth (in m.) does the ice layer begin?'
+         write(*,*)'(currently, the deepest soil layer extends down to:'
+     &              ,layer(nsoilmx),')'
+	 ierr=1
+	 do while (ierr.ne.0)
+	  read(*,*,iostat=ierr) val2
+!	  write(*,*)'val2:',val2,'ierr=',ierr
+	  if (ierr.eq.0) then ! got a value, but do a sanity check
+	    if(val2.gt.layer(nsoilmx)) then
+	      write(*,*)'Depth should be less than ',layer(nsoilmx)
+	      ierr=1
+	    endif
+	    if(val2.lt.layer(1)) then
+	      write(*,*)'Depth should be more than ',layer(1)
+	      ierr=1
+	    endif
+	  endif
+         enddo ! of do while
+	 
+	 ! find the reference index iref the depth corresponds to
+	  do isoil=1,nsoilmx-1
+	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
+     &       then
+	     iref=isoil
+	     exit
+	   endif
+	  enddo
+	 
+!	 write(*,*)'iref:',iref,'  jref:',jref
+         
+	 ! thermal inertia of the ice:
+	 ierr=1
+	 do while (ierr.ne.0)
+          write(*,*)'What is the value of subterranean ice thermal inert
+     &ia? (e.g.: 2000)'
+          read(*,*,iostat=ierr)iceith
+	 enddo ! of do while
+	 
+	 ! recast ithfi() onto ith()
+	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+	 
+	 do j=jref,jjp1
+!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
+	    do i=1,iip1 ! loop on longitudes
+	     ! Build "equivalent" thermal inertia for the mixed layer
+	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
+     &                      ((layer(iref+1)-val2)/(iceith)**2)))
+	     ! Set thermal inertia of lower layers
+	     do isoil=iref+2,nsoilmx
+	      ith(i,j,isoil)=iceith ! ice
+	     enddo
+	    enddo ! of do i=1,iip1 
+	 enddo ! of do j=jref,jjp1
+	 
+
+	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+
+c       'mons_ice' : use MONS data to build subsurface ice table
+c       --------------------------------------------------------
+        else if (trim(modif).eq.'mons_ice') then
+        
+       ! 1. Load MONS data
+        call load_MONS_data(MONS_Hdn,MONS_d21)
+        
+        ! 2. Get parameters from user
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Northern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffN
+        enddo
+        ierr=1
+	do while (ierr.ne.0)
+          write(*,*) "Coefficient to apply to MONS 'depth' in Southern",
+     &               " Hemisphere?"
+          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
+          read(*,*,iostat=ierr) MONS_coeffS
+        enddo
+        ierr=1
+        do while (ierr.ne.0)
+          write(*,*) "Value of subterranean ice thermal inertia ",
+     &               " in Northern hemisphere?"
+          write(*,*) " (e.g.: 2000, or perhaps 2290)"
+!          read(*,*,iostat=ierr) iceith
+          read(*,*,iostat=ierr) iceithN
+        enddo
+        ierr=1
+        do while (ierr.ne.0)
+          write(*,*) "Value of subterranean ice thermal inertia ",
+     &               " in Southern hemisphere?"
+          write(*,*) " (e.g.: 2000, or perhaps 2290)"
+!          read(*,*,iostat=ierr) iceith
+          read(*,*,iostat=ierr) iceithS
+        enddo
+        
+        ! 3. Build subterranean thermal inertia
+        
+        ! initialise subsurface inertia with reference surface values
+        do isoil=1,nsoilmx
+          ithfi(1:ngridmx,isoil)=surfithfi(1:ngridmx)
+        enddo
+        ! recast ithfi() onto ith()
+	call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
+        
+        do i=1,iip1 ! loop on longitudes
+          do j=1,jjp1 ! loop on latitudes
+            ! set MONS_coeff
+            if (rlatu(j).ge.0) then ! northern hemisphere
+              ! N.B: rlatu(:) contains decreasing values of latitude
+	      !       starting from PI/2 to -PI/2
+              MONS_coeff=MONS_coeffN
+              iceith=iceithN
+            else ! southern hemisphere
+              MONS_coeff=MONS_coeffS
+              iceith=iceithS
+            endif
+            ! check if we should put subterranean ice
+            if (MONS_Hdn(i,j).ge.14.0) then ! no ice if Hdn<14%
+              ! compute depth at which ice lies:
+              val=MONS_d21(i,j)*MONS_coeff
+              ! compute val2= the diurnal skin depth of surface inertia
+              ! assuming a volumetric heat cap. of C=1.e6 J.m-3.K-1
+              val2=ith(i,j,1)*1.e-6*sqrt(88775./3.14159)
+              if (val.lt.val2) then
+                ! ice must be below the (surface inertia) diurnal skin depth
+                val=val2
+              endif
+              if (val.lt.layer(nsoilmx)) then ! subterranean ice
+                ! find the reference index iref that depth corresponds to
+                iref=0
+                do isoil=1,nsoilmx-1
+                 if ((val.ge.layer(isoil)).and.(val.lt.layer(isoil+1)))
+     &             then
+	           iref=isoil
+	           exit
+	         endif
+                enddo
+                ! Build "equivalent" thermal inertia for the mixed layer
+                ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
+     &                     (((val-layer(iref))/(ith(i,j,iref+1)**2))+
+     &                      ((layer(iref+1)-val)/(iceith)**2)))
+	        ! Set thermal inertia of lower layers
+                do isoil=iref+2,nsoilmx
+                  ith(i,j,isoil)=iceith 
+                enddo
+              endif ! of if (val.lt.layer(nsoilmx))
+            endif ! of if (MONS_Hdn(i,j).lt.14.0)
+          enddo ! do j=1,jjp1
+        enddo ! do i=1,iip1
+        
+! Check:
+!         do i=1,iip1
+!           do j=1,jjp1
+!             do isoil=1,nsoilmx
+!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
+!             enddo
+!           enddo
+!	 enddo
+
+        ! recast ith() into ithfi()
+        CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
+        
+	else
+          write(*,*) '       Unknown (misspelled?) option!!!'
+        end if ! of if (trim(modif) .eq. '...') elseif ...
+	
+       enddo ! of do ! infinite loop on liste of changes
+
+ 999  continue
+
+ 
+c=======================================================================
+c   Correct pressure on the new grid (menu 0)
+c=======================================================================
+
+      if (choix_1.eq.0) then
+        r = 1000.*8.31/mugaz
+
+        do j=1,jjp1
+          do i=1,iip1
+             ps(i,j) = ps(i,j) * 
+     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
+     .                                  (t(i,j,1) * r))
+          end do
+        end do
+  
+c periodicity of surface ps in longitude
+        do j=1,jjp1
+          ps(1,j) = ps(iip1,j)
+        end do
+      end if
+
+c=======================================================================
+c=======================================================================
+
+c=======================================================================
+c    Initialisation de la physique / ecriture de newstartfi :
+c=======================================================================
+
+
+      CALL inifilr 
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+
+c-----------------------------------------------------------------------
+c   Initialisation  pks:
+c-----------------------------------------------------------------------
+
+      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+! Calcul de la temperature potentielle teta
+
+      if (flagiso) then
+          DO l=1,llm
+             DO j=1,jjp1
+                DO i=1,iim
+                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
+                ENDDO
+                teta (iip1,j,l)= teta (1,j,l)
+             ENDDO
+          ENDDO
+      else if (choix_1.eq.0) then
+         DO l=1,llm
+            DO j=1,jjp1
+               DO i=1,iim
+                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
+               ENDDO
+               teta (iip1,j,l)= teta (1,j,l)
+            ENDDO
+         ENDDO
+      endif
+
+C Calcul intermediaire
+c
+      if (choix_1.eq.0) then
+         CALL massdair( p3d, masse  )
+c
+         print *,' ALPHAX ',alphax
+
+         DO  l = 1, llm
+           DO  i    = 1, iim
+             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
+             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
+           ENDDO
+             xpn      = SUM(xppn)/apoln
+             xps      = SUM(xpps)/apols
+           DO i   = 1, iip1
+             masse(   i   ,   1     ,  l )   = xpn
+             masse(   i   ,   jjp1  ,  l )   = xps
+           ENDDO
+         ENDDO
+      endif
+      phis(iip1,:) = phis(1,:)
+
+      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
+     *                tetagdiv, tetagrot , tetatemp  )
+      itau=0
+      if (choix_1.eq.0) then
+         day_ini=int(date)
+         hour_ini=date-int(date)
+      endif
+c
+      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
+
+      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
+     *                phi,w, pbaru,pbarv,day_ini+time )
+c     CALL caldyn
+c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
+c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
+
+      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
+      CALL dynredem1("restart.nc",hour_ini,vcov,ucov,teta,q,
+     .               nqtot,masse,ps)
+C
+C Ecriture etat initial physique
+C
+
+      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
+     .              nqtot,dtphys,real(day_ini),0.0,
+     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nqtot,
+     .              dtphys,hour_ini,
+     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
+
+c=======================================================================
+c	Formats 
+c=======================================================================
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+
+      write(*,*) "newstart: All is well that ends well."
+
+      end
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine load_MONS_data(MONS_Hdn,MONS_d21)
+      implicit none
+      ! routine to load Benedicte Diez MONS dataset, fill in date in southern
+      ! polar region, and interpolate the result onto the GCM grid
+#include"dimensions.h"
+#include"paramet.h"
+#include"datafile.h"
+#include"comgeom.h"
+      ! arguments:
+      real,intent(out) :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
+      real,intent(out) :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
+      ! N.B MONS datasets should be of dimension (iip1,jjp1)
+      ! local variables:
+      character(len=88) :: filename="results_MONS_lat_lon_H_depth.txt"
+      character(len=88) :: txt ! to store some text
+      integer :: ierr,i,j
+      integer,parameter :: nblon=180 ! number of longitudes of MONS datasets
+      integer,parameter :: nblat=90 ! number of latitudes of MONS datasets
+      real :: pi
+      real :: longitudes(nblon) ! MONS dataset longitudes
+      real :: latitudes(nblat)  ! MONS dataset latitudes
+      ! MONS dataset: mass fraction of H2O where H is assumed to be in H2O
+      real :: Hdn(nblon,nblat)
+      real :: d21(nblon,nblat)! MONS dataset "depth" (g/cm2)
+
+      ! Extended MONS dataset (for interp_horiz)
+      real :: Hdnx(nblon+1,nblat)
+      real :: d21x(nblon+1,nblat)
+      real :: lon_bound(nblon+1) ! longitude boundaries
+      real :: lat_bound(nblat-1) ! latitude boundaries
+
+      ! 1. Initializations:
+
+      write(*,*) "Loading MONS data"
+
+      ! Open MONS datafile:
+      open(42,file=trim(datafile)//"/"//trim(filename),
+     &     status="old",iostat=ierr)
+      if (ierr/=0) then
+        write(*,*) "Error in load_MONS_data:"
+        write(*,*) "Failed opening file ",
+     &             trim(datafile)//"/"//trim(filename)
+        write(*,*)'1) You can change the path to the file in '
+        write(*,*)'   file phymars/datafile.h'
+        write(*,*)'2) If necessary ',trim(filename),
+     &                 ' (and other datafiles)'
+        write(*,*)'   can be obtained online at:'
+        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
+        CALL ABORT
+      else ! skip first line of file (dummy read)
+         read(42,*) txt
+      endif
+
+      pi=2.*asin(1.)
+      
+      !2. Load MONS data (on MONS grid)
+      do j=1,nblat
+        do i=1,nblon
+        ! swap latitude index so latitudes go from north pole to south pole:
+          read(42,*) latitudes(nblat-j+1),longitudes(i),
+     &               Hdn(i,nblat-j+1),d21(i,nblat-j+1)
+        ! multiply d21 by 10 to convert from g/cm2 to kg/m2
+          d21(i,nblat-j+1)=d21(i,nblat-j+1)*10.0
+        enddo
+      enddo
+      close(42)
+      
+      ! there is unfortunately no d21 data for latitudes -77 to -90
+      ! so we build some by linear interpolation between values at -75
+      ! and assuming d21=0 at the pole
+      do j=84,90 ! latitudes(84)=-77 ; latitudes(83)=-75
+        do i=1,nblon
+          d21(i,j)=d21(i,83)*((latitudes(j)+90)/15.0)
+        enddo
+      enddo
+
+      ! 3. Build extended MONS dataset & boundaries (for interp_horiz)
+      ! longitude boundaries (in radians):
+      do i=1,nblon
+        ! NB: MONS data is every 2 degrees in longitude
+        lon_bound(i)=(longitudes(i)+1.0)*pi/180.0
+      enddo
+      ! extra 'modulo' value
+      lon_bound(nblon+1)=lon_bound(1)+2.0*pi
+      
+      ! latitude boundaries (in radians):
+      do j=1,nblat-1
+        ! NB: Mons data is every 2 degrees in latitude
+        lat_bound(j)=(latitudes(j)-1.0)*pi/180.0
+      enddo
+      
+      ! MONS datasets:
+      do j=1,nblat
+        Hdnx(1:nblon,j)=Hdn(1:nblon,j)
+        Hdnx(nblon+1,j)=Hdnx(1,j)
+        d21x(1:nblon,j)=d21(1:nblon,j)
+        d21x(nblon+1,j)=d21x(1,j)
+      enddo
+      
+      ! Interpolate onto GCM grid
+      call interp_horiz(Hdnx,MONS_Hdn,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      call interp_horiz(d21x,MONS_d21,nblon,nblat-1,iim,jjm,1,
+     &                  lon_bound,lat_bound,rlonu,rlatv)
+      
+      end subroutine
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/readhead_NC.F	(revision 1403)
@@ -0,0 +1,231 @@
+      SUBROUTINE readhead_NC (fichnom,
+     .           day0,
+     .           phis,constR)
+      IMPLICIT none
+c======================================================================
+c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+c  Adaptation à Mars : Yann Wanherdrick 
+c Objet: Lecture de l etat initial pour la physique
+c======================================================================
+#include "netcdf.inc"
+c====== includes de l ancien readhead ===
+#include "dimensions.h"
+#include "paramet.h"
+#include "temps.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "description.h"
+
+c======================================================================
+
+      CHARACTER*(*) fichnom
+      INTEGER nbsrf !Mars nbsrf a 1 au lieu de 4
+      PARAMETER (nbsrf=1) ! nombre de sous-fractions pour une maille
+
+      INTEGER radpas
+
+      REAL xmin, xmax
+c
+      INTEGER  i
+
+c   Variables
+c
+      INTEGER length,iq
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      INTEGER ierr, nid, nvarid
+      CHARACTER  str3*3
+
+c
+      INTEGER day0
+      REAL phis(ip1jmp1),constR
+c
+c Ouvrir le fichier contenant l etat initial:
+c
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//fichnom
+        CALL ABORT
+      ENDIF
+c
+c Lecture des parametres de controle:
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <controle>'
+         CALL abort
+      ENDIF
+
+
+c Info sur la Planete Mars pour la dynamique 
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ini    = tab_cntrl(4)
+      rad        = tab_cntrl(5)
+      omeg       = tab_cntrl(6)
+      g          = tab_cntrl(7)
+c      mugaz      = tab_cntrl(8)
+      cpp        =  744.499
+      kappa      = tab_cntrl(9)
+      daysec     = tab_cntrl(10)
+      dtvr       = tab_cntrl(11)
+      etot0      = tab_cntrl(12)
+      ptot0      = tab_cntrl(13)
+      ztot0      = tab_cntrl(14)
+      stot0      = tab_cntrl(15)
+      ang0       = tab_cntrl(16)
+c pas vrai pour diagfi, seulement pour start      preff      = tab_cntrl(18)
+      preff=610.
+      WRITE (*,*) 'readhead -     preff ' , preff 
+c
+
+      day0=day_ini
+
+      constR=kappa*cpp
+      WRITE (*,*) 'constR = ' , constR
+      r=constR
+      IF(   im.ne.iim           )  THEN
+          PRINT 1,im,iim
+          STOP
+      ELSE  IF( jm.ne.jjm       )  THEN
+          PRINT 2,jm,jjm
+          STOP
+      ELSE  IF( lllm.ne.llm     )  THEN
+          PRINT 3,lllm,llm
+          STOP
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlonu> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+                                                                       
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <rlatv> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+c
+c Lecture des aires des mailles:
+c
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <aire> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <aire>'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINVAL(aire)
+      xmax = MAXVAL(aire)
+      PRINT*,'Aires des mailles <aire>:', xmin, xmax
+c
+c Lecture du geopotentiel au sol:
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Le champ <phisinit> est absent'
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
+#endif
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, 'readhead_NC: Lecture echouee pour <phis>'
+         CALL abort
+      ENDIF
+c      PRINT*,'READHEAD_NC  Phis:',phis
+
+      ierr = NF_INQ_VARID (nid, "aps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <aps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, aps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <aps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "bps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Le champ <bps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bps)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "readhead_NC: Lecture echouee pour <bps>"
+         CALL abort
+      ENDIF
+
+   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree iim =',i4//)
+   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
+     *rrage est differente de la valeur parametree jjm =',i4//)
+   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur parametree llm =',i4//)
+   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier demar
+     *rage est differente de la valeur  dtinteg =',i4//)
+
+      
+c Fermer le fichier:
+c
+      ierr = NF_CLOSE(nid)
+c
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/scal_wind.F	(revision 1403)
@@ -0,0 +1,55 @@
+      SUBROUTINE scal_wind(xus,xvs,xu,xv)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c On passe  les variable xus, xvs  aux points de vent u et v (xu et xv)
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL xu(iip1,jjp1,llm),xv(iip1,jjm,llm)
+      REAL xus(iip1,jjp1,llm), xvs (iip1,jjp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER i,j,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+        Do j=1,jjp1
+	      DO i=1,iim
+            xu(i,j,l)=0.5*(xus(i,j,l)+xus(i+1,j,l))
+	      ENDDO
+          xu(iip1,j,l)=xu(1,j,l)
+	    ENDDO
+      ENDDO
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO j=1,jjm
+           do i=1 ,iip1
+	         xv(i,j,l)=.5*(xvs(i,j,l)+xvs(i,j+1,l))
+           end do
+	     ENDDO
+	  ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/sponge.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/sponge.h
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/start2archive.F	(revision 1403)
@@ -0,0 +1,413 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c
+c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
+c   -----    "startfi" a un fichier netcdf unique "start_archive" 
+c
+c  "start_archive" est une banque d'etats initiaux:
+c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
+c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
+c 
+c
+c
+c=======================================================================
+
+      use infotrac, only: iniadvtrac, nqtot, tname
+      use comsoil_h, only: nsoilmx, inertiedat
+      use surfdat_h, only: ini_surfdat_h, qsurf
+      use comsoil_h, only: ini_comsoil_h
+      use comgeomphy, only: initcomgeomphy
+      use filtreg_mod, only: inifilr
+      implicit none
+
+#include "dimensions.h"
+      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      REAL tsurf(ngridmx)	! Surface temperature
+      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
+      REAL co2ice(ngridmx)	! CO2 ice layer
+      REAL tauscaling(ngridmx) ! dust conversion factor
+      REAL q2(ngridmx,llm+1)
+      REAL emis(ngridmx)
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      INTEGER*4 day_ini_fi
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1)
+      REAL tsoilS(ip1jmp1,nsoilmx)
+      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
+      REAL co2iceS(ip1jmp1)
+      REAL tauscalingS(ip1jmp1)
+      REAL q2S(ip1jmp1,llm+1)
+      REAL,ALLOCATABLE :: qsurfS(:,:)
+      REAL emisS(ip1jmp1)
+
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      LOGICAL startdrs
+      INTEGER Lmodif
+
+      REAL ptotal, co2icetotal
+      REAL timedyn,timefi !fraction du jour dans start, startfi
+      REAL date
+
+      CHARACTER*2 str2
+      CHARACTER*80 fichier 
+      data  fichier /'startfi'/
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr,ntime
+      integer :: nq,numvanle
+      character(len=30) :: txt ! to store some text
+
+c Netcdf
+c-------
+      integer varid,dimid,timelen 
+      INTEGER nid,nid1
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .TRUE. )
+      grireg   = .TRUE.
+! initialize "serial/parallel" related stuff
+      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+! Load tracer number and names:
+      call iniadvtrac(nqtot,numvanle)
+
+! allocate arrays:
+      allocate(q(ip1jmp1,llm,nqtot))
+      allocate(qsurfS(ip1jmp1,nqtot))
+      call ini_surfdat_h(ngridmx,nqtot)
+      call ini_comsoil_h(ngridmx)
+      
+
+      fichnom = 'start.nc'
+      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,timedyn)
+
+
+      fichnom = 'startfi.nc'
+      Lmodif=0
+
+      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
+     &      day_ini_fi,timefi,tsurf,tsoil,emis,q2,qsurf,co2ice,
+     &      tauscaling)
+
+       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
+       IF (ierr.NE.NF_NOERR) THEN
+         write(6,*)' Pb d''ouverture du fichier'//fichnom
+        CALL ABORT
+       ENDIF
+                                                
+      ierr = NF_INQ_VARID (nid1, "controle", varid)
+      IF (ierr .NE. NF_NOERR) THEN
+       PRINT*, "start2archive: Le champ <controle> est absent"
+       CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
+#else
+      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
+#endif
+       IF (ierr .NE. NF_NOERR) THEN
+          PRINT*, "start2archive: Lecture echoue pour <controle>"
+          CALL abort
+       ENDIF
+
+      ierr = NF_CLOSE(nid1)
+
+c-----------------------------------------------------------------------
+c Controle de la synchro
+c-----------------------------------------------------------------------
+!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
+      if ((day_ini_fi.ne.day_ini)) 
+     &  stop ' Probleme de Synchro entre start et startfi !!!'
+
+
+c *****************************************************************
+c    Option : Reinitialisation des dates dans la premieres annees :
+       do while (day_ini.ge.669)
+          day_ini=day_ini-669
+       enddo
+c *****************************************************************
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      CALL defrun_new(99, .FALSE. )
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
+
+c=======================================================================
+c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
+c=======================================================================
+c  Les variables modeles dependent de la resolution. Il faut donc
+c  eliminer les facteurs responsables de cette dependance
+c  (pour utiliser newstart)
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Vent   (depend de la resolution horizontale) 
+c-----------------------------------------------------------------------
+c
+c ucov --> un  et  vcov --> vn
+c un --> us  et   vn --> vs
+c
+c-----------------------------------------------------------------------
+
+      call covnat(llm,ucov, vcov, un, vn) 
+      call wind_scal(un,vn,us,vs) 
+
+c-----------------------------------------------------------------------
+c Temperature  (depend de la resolution verticale => de "sigma.def")
+c-----------------------------------------------------------------------
+c
+c h --> T
+c
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
+         ENDDO
+      ENDDO
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c co2ice --> co2iceS
+c tsoil --> tsoilS
+c emis --> emisS
+c q2 --> q2S
+c qsurf --> qsurfS
+c tauscaling --> tauscalingS
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      ! Note: thermal inertia "inertiedat" is in comsoil.h
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
+      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
+      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      co2icetotal = 0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+           co2icetotal = co2icetotal + 
+     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(49) = ptotal
+      tab_cntrl_fi(50) = co2icetotal
+
+c=======================================================================
+c Ecriture dans le fichier  "start_archive"
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Ouverture de "start_archive" 
+c-----------------------------------------------------------------------
+
+      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
+ 
+c-----------------------------------------------------------------------
+c  si "start_archive" n'existe pas:
+c    1_ ouverture
+c    2_ creation de l'entete dynamique ("ini_archive")
+c-----------------------------------------------------------------------
+c ini_archive:
+c On met dans l'entete le tab_cntrl dynamique (1 a 16) 
+c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
+c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
+c-----------------------------------------------------------------------
+
+      if (ierr.ne.NF_NOERR) then
+         write(*,*)'OK, Could not open file "start_archive.nc"'
+         write(*,*)'So let s create a new "start_archive"'
+         ierr = NF_CREATE('start_archive.nc', 
+     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
+         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture de la coordonnee temps (date en jours)
+c-----------------------------------------------------------------------
+
+      date = day_ini + hour_ini
+      ierr= NF_INQ_VARID(nid,"Time",varid)
+      ierr= NF_INQ_DIMID(nid,"Time",dimid)
+      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
+      ntime=timelen+1
+
+      write(*,*) "******************"
+      write(*,*) "ntime",ntime
+      write(*,*) "******************"
+#ifdef NC_DOUBLE
+      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
+#else
+      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write(*,*) "time matter ",NF_STRERROR(ierr)
+         stop
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
+c-----------------------------------------------------------------------
+c ATTENTION: q2 a une couche de plus!!!!
+c    Pour creer un fichier netcdf lisible par grads,
+c    On passe donc une des couches de q2 a part
+c    comme une variable 2D (la couche au sol: "q2surf")
+c    Les lmm autres couches sont nommees "q2atm" (3D) 
+c-----------------------------------------------------------------------
+
+      call write_archive(nid,ntime,'co2ice','couche de glace co2',
+     &  'kg/m2',2,co2iceS)
+      call write_archive(nid,ntime,'tauscaling',
+     &  'dust conversion factor',' ',2,tauscalingS)
+      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
+      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
+      call write_archive(nid,ntime,'temp','temperature','K',3,t)
+      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
+     .              q2S)
+      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
+     .              q2S(1,2))
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+c       write(str2,'(i2.2)') iq
+c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
+c     .         3,q(1,1,iq))
+        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
+     &         3,q(1,1,iq))
+      end do
+c-----------------------------------------------------------------------
+c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
+c-----------------------------------------------------------------------
+      do iq=1,nqtot
+c       write(str2,'(i2.2)') iq
+c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
+c     $  'kg.m-2',2,qsurfS(1,iq))
+        txt=trim(tname(iq))//"_surf"
+        call write_archive(nid,ntime,txt,'Tracer on surface',
+     &  'kg.m-2',2,qsurfS(1,iq))
+      enddo
+
+
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tg[1,10] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans 10 couches dans le sol
+c   Les 10 couches sont lues comme 10 champs 
+c  nommees Tg[1,10]
+
+c      do isoil=1,nsoilmx
+c       write(str2,'(i2.2)') isoil
+c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
+c     .   'K',2,tsoilS(1,isoil))
+c      enddo
+
+! Write soil temperatures tsoil
+      call write_archive(nid,ntime,'tsoil','Soil temperature',
+     &     'K',-3,tsoilS)
+
+! Write soil thermal inertia
+      call write_archive(nid,ntime,'inertiedat',
+     &     'Soil thermal inertia',
+     &     'J.s-1/2.m-2.K-1',-3,ithS)
+
+! Write (0D) volumetric heat capacity (stored in comsoil.h)
+!      call write_archive(nid,ntime,'volcapa',
+!     &     'Soil volumetric heat capacity',
+!     &     'J.m-3.K-1',0,volcapa)
+! Note: no need to write volcapa, it is stored in "controle" table
+
+      ierr=NF_CLOSE(nid)
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+
+      write(*,*) "startarchive: all is well that ends well"
+      
+      end 
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/wind_scal.F	(revision 1403)
@@ -0,0 +1,55 @@
+      SUBROUTINE wind_scal(pbaru,pbarv,us,vs)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c   On ramene les flux de masse /vents  aux points scalaires.
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL us(ip1jmp1,llm), vs (ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER ij,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+	 DO ij=2,ip1jmp1
+            us(ij,l)=.5*(pbaru(ij,l)+pbaru(ij-1,l))
+	 ENDDO
+      ENDDO
+      CALL SCOPY(jjp1*llm,us(iip1,1),iip1,us(1,1),iip1)
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+	    vs(ij,l)=.5*(pbarv(ij,l)+pbarv(ij-iip1,l))
+	 ENDDO
+	 DO ij=1,iip1
+	    vs(ij,l)=0.
+	    vs(ip1jm+ij,l)=0.
+	 ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/write_archive.F	(revision 1403)
@@ -0,0 +1,252 @@
+c=======================================================================
+      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
+c   -----    dans un fichier DRS nomme "start_archive"
+c
+c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
+c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
+c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
+c    (ex: la longitude solaire)
+c
+c
+c   Arguments: 
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c		  nid      Unite logique du fichier "start_archive"
+c         nom      nom du champ a ecrire dans le fichier "start_archive"
+c         titre    titre de la variable dans le fichier DRS "start_archive"
+c         unite    unite de la variable ....
+c         dim      dimension de la variable a ecrire
+c         px       tableau contenant la variable a ecrire
+c
+c
+c=======================================================================
+
+      use comsoil_h, only: nsoilmx
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+!#include "control.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid
+      integer ntime ! time index
+      integer dim 
+      REAL px(iip1,jjp1,llm) 
+
+      CHARACTER*(*) nom, titre, unite
+
+      integer ierr
+
+
+c local
+      integer, dimension(4) :: edges,corner,id
+      integer :: varid,i,j,l
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+! For an atmospheric 3D Variable
+!--------------------------------
+        if (dim.eq.3) then
+
+!         Ecriture du champs
+
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+! mars s'arranger pour qu'il n'y ai plus besoin de ca
+
+c          do l=1,llm
+c             do j=1,jjp1
+c                do i=1,iip1
+c                   pxbis(i,j,l)=px(i,j,llm-l+1)
+c                enddo
+c             enddo
+c          enddo
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+! For a subterranean 3D Variable
+!-------------------------------
+
+        else if (dim.eq.-3) then
+	! get variables' ID, if it exists
+	ierr=NF_INQ_VARID(nid,nom,varid)
+	
+	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
+	  ! build related coordinates
+	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
+	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
+	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
+	  if (ierr.ne.NF_NOERR) then
+	   write(*,*)"write_archive: dimension <subsurface_layers>",
+     &               " is missing !!!"
+	   call abort
+	  endif
+          ierr=NF_INQ_DIMID(nid,"Time",id(4))
+	  
+	  ! define the variable
+	  write(*,*)"====================="
+	  write(*,*)"defining ",nom
+	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+	  
+	 endif
+
+        ! build cedges and corners
+        corner(1)=1
+        corner(2)=1
+        corner(3)=1
+        corner(4)=ntime
+
+        edges(1)=iip1
+        edges(2)=jjp1
+        edges(3)=nsoilmx
+        edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+
+! For a surface 2D Variable
+!--------------------------
+
+        else if (dim.eq.2) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"Time",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+        else
+	  write(*,*) "write_archive: dim=",dim," ?!?"
+	  call abort
+        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
+
+      return
+      end
+
Index: trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F
===================================================================
--- trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/dynlonlat_phylonlat/phymars/xvik.F	(revision 1403)
@@ -0,0 +1,547 @@
+      PROGRAM xvik
+
+      USE filtreg_mod, ONLY: inifilr
+
+      IMPLICIT NONE
+c=======================================================================
+c
+c  Pression au site Viking
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissip.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+!#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "netcdf.inc"      
+
+
+      INTEGER itau,nbpas,nbpasmx
+      PARAMETER(nbpasmx=1000000)
+      REAL temps(nbpasmx)
+      INTEGER unitlec
+      INTEGER i,j,l,jj
+      REAL constR
+
+c   Declarations NCDF:
+c   -----------------
+      CHARACTER*100  varname
+      INTEGER ierr,nid,nvarid,dimid
+      LOGICAL nc
+      INTEGER start_ps(3),start_temp(4),start_co2ice(3)
+      INTEGER count_ps(3),count_temp(4),count_co2ice(3)
+
+c   declarations pour les points viking:
+c   ------------------------------------
+      INTEGER ivik(2),jvik(2),ifile(2),iv
+      REAL lonvik(2),latvik(2),phivik(2),phisim(2)
+      REAL unanj
+
+c   variables meteo:
+c   ----------------
+      REAL vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+      REAL t(iip1,jjp1,llm),ps(iip1,jjp1),pstot, phis(iip1,jjp1)
+      REAL co2ice(iip1,jjp1), captotN,captotS
+      real t7(iip1,jjp1) ! temperature in 7th atmospheric layer
+
+      REAL zp1,zp2,zp2_sm,zu,zv,zw(0:1,0:1,2),zalpha,zbeta
+
+      LOGICAL firstcal,lcal,latcal,lvent,day_ls
+      INTEGER*4 day0
+
+      REAL ziceco2(iip1,jjp1)
+      REAL day,zt,sollong,sol,dayw
+      REAL airtot1,gh
+
+      INTEGER ii,iyear,kyear
+
+      CHARACTER*2 chr2
+
+       
+c   declarations de l'interface avec mywrite:
+c   -----------------------------------------
+
+      CHARACTER file*80
+      CHARACTER pathchmp*80,pathsor*80,nomfich*80
+
+c   externe:
+c   --------
+
+      EXTERNAL iniconst,inigeom,covcont,mywrite
+      EXTERNAL exner,pbar
+      EXTERNAL solarlong,coordij,moy2
+      EXTERNAL SSUM
+      REAL SSUM
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      unanj=667.9
+      print*,'WARNING!!!',unanj,'Jours/an'
+      nc=.true.
+      lcal=.true.
+      latcal=.true.
+      lvent=.false.
+      day_ls=.true.
+
+c lecture du fichier xvik.def
+
+      phivik(1)=-3627
+      phivik(2)=-4505
+
+
+
+      OPEN(99,file='xvik.def',form='formatted')
+
+      READ(99,*) 
+      READ(99,*,iostat=ierr) phivik
+      IF(ierr.NE.0) GOTO 105
+
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathchmp
+      READ(99,*,END=105)
+      READ(99,'(a)',END=105) pathsor
+      READ(99,*,END=105)
+c     READ(99,'(l1)',END=105) day_ls
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lcal
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) lvent
+      READ(99,'(l1)',END=105)
+      READ(99,'(l1)',END=105) latcal
+ 
+ 105  CONTINUE
+      CLOSE(99)
+      write (*,*)'>>>>>>>>>>>>>>>>', phivik,g
+      DO iv=1,2
+         phivik(iv)=phivik(iv)*3.73
+      END DO
+
+      write(*,*) ' pathchmp:',trim(pathchmp)
+      write(*,*) ' pathsor:',trim(pathsor)
+      
+c-----------------------------------------------------------------------
+c-----------------------------------------------------------------------
+c   ouverture des fichiers xgraph:
+c   ------------------------------
+
+      ifile(1)=12
+      ifile(2)=13
+      kyear=-1
+c      OPEN(77,file='xlongday',form='formatted')
+
+      unitlec=11
+c
+      PRINT*,'entrer le nom du fichier NC'
+      READ(5,'(a)') nomfich
+
+      PRINT *,'nomfich : ',nomfich
+
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   grande boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      firstcal=.true.
+      DO WHILE(len_trim(nomfich).GT.0.AND.len_trim(nomfich).LT.50)
+      PRINT *,'>>>  nomfich : ',trim(nomfich)
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      file=pathchmp(1:len_trim(pathchmp))//'/'//
+     s     nomfich(1:len_trim(nomfich))
+      PRINT*,'file.nc: ', file(1:len_trim(file))//'.nc'
+      PRINT*,'timestep ',dtvr
+
+      IF(nc) THEN
+      ierr= NF_OPEN(file(1:len_trim(file))//'.nc',NF_NOWRITE,nid)        
+      ELSE
+         PRINT*,'Ouverture binaire ',file
+         OPEN(unitlec,file=file,status='old',form='unformatted',
+     .   iostat=ierr)
+      ENDIF
+
+c----------------------------------------------------------------------
+c   initialisation de la physique:
+c   ------------------------------
+
+      CALL readhead_NC(file(1:len_trim(file))//'.nc',day0,phis,constR)
+
+      WRITE (*,*) 'day0 = ' , day0
+
+      CALL iniconst
+      CALL inigeom
+      CALL inifilr
+
+
+c   Lecture temps :
+
+      ierr= NF_INQ_DIMID (nid,"Time",dimid)
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Le champ <Time> est absent'
+          CALL abort
+        ENDIF
+
+      ierr= NF_INQ_DIMLEN (nid,dimid,nbpas)
+
+      ierr = NF_INQ_VARID (nid, "Time", nvarid)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, temps)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, temps)
+#endif
+        IF (ierr.NE.NF_NOERR) THEN
+          PRINT*, 'xvik: Lecture echouee pour <Time>'
+          CALL abort
+        ENDIF
+
+        PRINT*,'temps',(temps(itau),itau=1,10)
+              
+c-----------------------------------------------------------------------
+c   coordonnees des point Viking:
+c   -----------------------------
+
+      latvik(1)=22.27*pi/180.
+      lonvik(1)=-47.9*pi/180.
+      latvik(2)=47.67*pi/180.
+      lonvik(2)=(360.-225.71)*pi/180.
+
+c   ponderations pour les 4 points autour de Viking
+      DO iv=1,2
+         CALL coordij(lonvik(iv),latvik(iv),ivik(iv),jvik(iv))
+         IF(lonvik(iv).lt.rlonv(ivik(iv))) THEN
+            ivik(iv)=ivik(iv)-1
+         ENDIF
+         IF(latvik(iv).gt.rlatu(jvik(iv))) THEN
+            jvik(iv)=jvik(iv)-1
+         ENDIF
+         zalpha=(lonvik(iv)-rlonv(ivik(iv)))/
+     s          (rlonv(ivik(iv)+1)-rlonv(ivik(iv)))
+         zbeta=(latvik(iv)-rlatu(jvik(iv)))/
+     s          (rlatu(jvik(iv)+1)-rlatu(jvik(iv)))
+         zw(0,0,iv)=(1.-zalpha)*(1.-zbeta)
+         zw(1,0,iv)=zalpha*(1.-zbeta)
+         zw(0,1,iv)=(1.-zalpha)*zbeta
+         zw(1,1,iv)=zalpha*zbeta
+      ENDDO
+
+c   altitude reelle et modele aux points Viking
+      DO iv=1,2
+         phisim(iv)=0.
+         DO jj=0,1
+            j=jvik(iv)+jj
+            DO ii=0,1
+               i=ivik(iv)+ii
+               phisim(iv)=phisim(iv)+zw(ii,jj,iv)*phis(i,j)
+            ENDDO
+         ENDDO
+      ENDDO
+      PRINT*,'relief aux points Viking pour les sorties:',phivik
+
+c----------------------------------------------------------------------
+c   lectures des etats:
+c   -------------------
+
+       airtot1=1./(SSUM(ip1jmp1,aire,1)-SSUM(jjp1,aire,iip1))
+
+c======================================================================
+c   debut de la boucle sur les etats dans un fichier histoire:
+c======================================================================
+       count_ps=(/iip1,jjp1,1/)
+       count_co2ice=(/iip1,jjp1,1/)
+       count_temp=(/iip1,jjp1,llm,1/)
+       
+       DO itau=1,nbpas
+
+       start_ps=(/1,1,itau/)
+       start_co2ice=(/1,1,itau/)
+       start_temp=(/1,1,1,itau/)
+c   lecture drs des champs:
+c   -----------------------
+c         varname='u'
+c         ierr=drsread (unitlec,varname,unat,itau)
+c         PRINT*,'unat',unat(iip1/2,jjp1/2,llm/2)
+c         varname='v'
+c         ierr=drsread (unitlec,varname,vnat,itau)
+c         PRINT*,'vnat',vnat(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE Ps ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "ps", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start_ps,count_ps, ps)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_ps,count_ps, ps)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <ps>'
+            CALL abort
+          ENDIF
+          
+          PRINT*,'ps',ps(iip1/2,jjp1/2)
+
+ccccccccc  LECTURE Temperature ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "temp", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_temp,count_temp, t)
+#else
+          ierr = NF_GET_VARA_REAL(nid,nvarid,start_temp,count_temp, t)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <temp>'
+            ! Ehouarn: proceed anyways
+            ! CALL abort
+            write(*,*)'--> Setting temperature to zero !!!'
+            t(1:iip1,1:jjp1,1:llm)=0.0
+            write(*,*)'--> looking for temp7 (temp in 7th layer)'
+            ierr=NF_INQ_VARID(nid,"temp7", nvarid)
+            if (ierr.eq.NF_NOERR) then
+            write(*,*) "    OK, found temp7 variable"
+#ifdef NC_DOUBLE
+            ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start_ps,count_ps,t7)
+#else
+            ierr=NF_GET_VARA_REAL(nid,nvarid,start_ps,count_ps,t7)
+#endif
+              if (ierr.ne.NF_NOERR) then
+                write(*,*)'xvik: failed loading temp7 !'
+                stop
+              endif
+            else ! no 'temp7' variable
+              write(*,*)'  No temp7 variable either !'
+              write(*,*)'  Will have to to without ...'
+              t7(1:iip1,1:jjp1)=0.0
+            endif
+          ELSE ! t() was successfully loaded, copy 7th layer to t7()
+            t7(1:iip1,1:jjp1)=t(1:iip1,1:jjp1,7)
+          ENDIF
+
+c          PRINT*,'t',t(iip1/2,jjp1/2,llm/2)
+
+ccccccccc  LECTURE co2ice ccccccccccccccccccccccccccc
+          ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
+#ifdef NC_DOUBLE
+          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start_co2ice,
+     &    count_co2ice,  co2ice)
+#else
+          ierr = NF_GET_VARA_REAL(nid, nvarid,start_co2ice,
+     &    count_co2ice, co2ice)
+#endif
+          IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, 'xvik: Lecture echouee pour <co2ice>'
+            CALL abort
+          ENDIF
+
+
+c Gestion du temps
+c ----------------
+          day=temps(itau)
+          PRINT*,'day ',day
+          CALL solarlong(day+day0,sollong)
+          sol=day+day0+461.
+          iyear=sol/unanj
+          WRITE (*,*) 'iyear',iyear
+          sol=sol-iyear*unanj
+c
+c Ouverture / fermeture des fichiers
+c ----------------------------------
+          IF (iyear.NE.kyear) THEN
+             WRITE(chr2(1:1),'(i1)') iyear+1
+             WRITE (*,*) 'iyear bis',iyear
+             WRITE (*,*) 'chr2'
+             WRITE (*,*)  chr2
+             IF(iyear.GE.9) WRITE(chr2,'(i2)') iyear+1
+             kyear=iyear
+             DO ii=1,2
+                CLOSE(10+ifile(ii))
+                CLOSE(2+ifile(ii))
+                CLOSE(4+ifile(ii))
+                CLOSE(6+ifile(ii))
+                CLOSE(8+ifile(ii))
+                CLOSE(16+ifile(ii))
+                CLOSE(12+ifile(ii))
+                CLOSE(14+ifile(ii))
+                CLOSE(97)
+                CLOSE(98)
+             ENDDO
+             CLOSE(5+ifile(1))
+             OPEN(ifile(1)+10,file='xpsol1'//chr2,form='formatted')
+             OPEN(ifile(2)+10,file='xpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+8,file='xbpsol1'//chr2,form='formatted')
+c            OPEN(ifile(2)+8,file='xbpsol2'//chr2,form='formatted')
+c            OPEN(ifile(1)+2,file='xlps1'//chr2,form='formatted')
+c            OPEN(ifile(2)+2,file='xlps2'//chr2,form='formatted')
+             IF(lcal) THEN
+c               OPEN(ifile(2)+4,file='xpressud'//chr2,form='formatted')
+c               OPEN(ifile(1)+4,file='xpresnord'//chr2,form='formatted')
+c               OPEN(ifile(1)+6,file='xpm2'//chr2,form='formatted')
+             ENDIF
+                         IF(latcal) THEN
+c               OPEN(ifile(2)+14,file='xlats'//chr2,form='formatted')
+c               OPEN(ifile(1)+14,file='xlatn'//chr2,form='formatted')
+                         ENDIF
+             IF(lvent) THEN
+c               OPEN(ifile(1)+16,file='xu1'//chr2,form='formatted')
+c               OPEN(ifile(2)+16,file='xu2'//chr2,form='formatted')
+c               OPEN(ifile(1)+12,file='xv1'//chr2,form='formatted')
+c               OPEN(ifile(2)+12,file='xv2'//chr2,form='formatted')
+             ENDIF
+             OPEN(97,file='xprestot'//chr2,form='formatted')
+c            OPEN(98,file='xlat37_'//chr2,form='formatted')
+           WRITE(98,'(f5.1,16f7.1)') 0.,(rlonv(i)*180./pi,i=1,iim,4)
+          ENDIF
+ 
+
+          sollong=sollong*180./pi
+          IF(day_ls) THEN
+             dayw=sol
+             write(*,*) 'dayw', dayw
+          ELSE
+             dayw=sollong
+          ENDIF
+
+c Calcul de la moyenne planetaire
+c -------------------------------
+          pstot=0.
+          captotS=0.
+          captotN=0.
+          DO j=1,jjp1
+             DO i=1,iim
+                pstot=pstot+aire(i,j)*ps(i,j)
+             ENDDO
+          ENDDO
+ 
+              DO j=1,jjp1/2
+                 DO i=1,iim
+                    captotN = captotN  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              DO j=jjp1/2+1, jjp1
+                 DO i=1,iim
+                    captotS = captotS  +aire(i,j)*co2ice(i,j)
+                 ENDDO
+              ENDDO
+              WRITE(97,'(4e16.6)') dayw,pstot*airtot1
+     &       , captotN*g*airtot1, captotS*g*airtot1          
+
+          IF(.NOT.firstcal) THEN
+         WRITE(98,'(f5.1,16f7.3)')
+     s    dayw,(ps(i,37),i=1,iim,4)
+
+c boucle sur les sites vikings:
+c ----------------------------
+
+          DO iv=1,2
+
+c interpolation de la temperature dans la 7eme couche, de la pression
+c de surface et des vents aux points viking.
+
+             zp1=0.
+             zp2=0.
+             zp2_sm=0.
+             zt=0.
+             zu=0.
+             zv=0.
+             DO jj=0,1
+                j=jvik(iv)+jj
+                DO ii=0,1
+                   i=ivik(iv)+ii
+!                   zt=zt+zw(ii,jj,iv)*t(i,j,7)
+                   zt=zt+zw(ii,jj,iv)*t7(i,j)
+!                   zp1=zp1+zw(ii,jj,iv)*ps(i,j)
+                   zp1=zp1+zw(ii,jj,iv)*log(ps(i,j)) ! interpolate in log(P)
+                    WRITE (*,*) 'ps autour iv',ps(i,j),iv
+                   zu=zu+zw(ii,jj,iv)*unat(i,j,1)/cu(i,j)
+                   zv=zv+zw(ii,jj,iv)*vnat(i,j,1)/cv(i,j)
+                ENDDO
+             ENDDO
+             zp1=exp(zp1) ! because of the bilinear interpolation in log(P)
+ 
+c               pression au sol extrapolee a partir de la temp. 7eme couche
+           WRITE (*,*) 'constR ',constR 
+           WRITE (*,*) 'zt ',zt
+             gh=constR*zt
+             if (gh.eq.0) then ! if we don't have temperature values
+               ! assume a scale height of 10km
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/(3.73*1.e4))
+             else
+               zp2=zp1*exp(-(phivik(iv)-phisim(iv))/gh)
+             endif
+           WRITE (*,*) 'iv,pstot,zp2, zp1, phivik(iv),phisim(iv),gh'
+           WRITE (*,*) iv,pstot*airtot1,zp2,zp1,phivik(iv),phisim(iv),gh
+!           WRITE(ifile(iv)+10,'(2e15.5)') dayw,zp1
+           WRITE(ifile(iv)+10,'(3e15.5)') dayw,zp2,zp1
+           
+c   sorties eventuelles de vent
+             IF(lvent) THEN
+                WRITE(ifile(iv)+16,'(2e15.5)')
+     s          dayw,zu
+                WRITE(ifile(iv)+12,'(2e15.5)')
+     s          dayw,zv
+             ENDIF
+          ENDDO
+c         IF (lcal) THEN
+c            WRITE(ifile(1)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(ip1jmp1/2,ziceco2,1)-SSUM(jjp1/2,ziceco2,iip1))
+c            WRITE(ifile(2)+4,'(2e15.6)') dayw,airtot1*g*.01*
+c    s       (SSUM(iip1*jjm/2,ziceco2(1,jjm/2+2),1)-
+c    s       SSUM(jjm/2,ziceco2(1,jjm/2+2),iip1))
+c         ENDIF
+c            IF(latcal) THEN
+c               CALL icelat(iim,jjm,ziceco2,rlatv,zicelat)
+c               WRITE(ifile(1)+14,'(2e15.6)') dayw,zicelat(1)*180./pi
+c               WRITE(ifile(2)+14,'(2e15.6)') dayw,zicelat(2)*180./pi
+c            ENDIF
+         ENDIF
+         firstcal=.false.
+
+c======================================================================
+c   Fin de la boucle sur les etats du fichier histoire:
+c======================================================================
+      ENDDO
+
+      ierr= NF_CLOSE(nid)
+
+      PRINT*,'Fin du fichier',nomfich
+      print*,'Entrer un nouveau fichier ou return pour finir'
+      READ(5,'(a)',err=9999) nomfich
+
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+c   Fin de la boucle sur les fichiers histoire:
+c%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      ENDDO
+
+      PRINT*,'relief du point V1',.001*phis(ivik(1),jvik(1))/g
+      PRINT*,'relief du point V2',.001*phis(ivik(2),jvik(2))/g
+      DO iv=1,2
+         PRINT*,'Viking',iv,'   i=',ivik(iv),'j  =',jvik(iv)
+         WRITE(6,7777)
+     s   (rlonv(i)*180./pi,i=ivik(iv)-1,ivik(iv)+2)
+         print*
+         DO j=jvik(iv)-1,jvik(iv)+2
+            WRITE(6,'(f8.1,10x,5f7.1)')
+     s   rlatu(j)*180./pi,(phis(i,j)/(g*1000.),i=ivik(iv)-1,ivik(iv)+2)
+         ENDDO
+         print*
+         print*,'zw'
+         write(6,'(2(2f10.4/))') ((zw(ii,jj,iv),ii=0,1),jj=0,1)
+         print*,'altitude interpolee (km) ',phisim(iv)/1000./g
+      ENDDO
+      PRINT*,'R=',r
+ 9999  PRINT*,'Fin '
+
+7777  FORMAT ('latitude/longitude',4f7.1)
+      END
Index: trunk/LMDZ.MARS/libf/filtrez/coefils.h
===================================================================
--- trunk/LMDZ.MARS/libf/filtrez/coefils.h	(revision 1399)
+++ trunk/LMDZ.MARS/libf/filtrez/coefils.h	(revision 1403)
@@ -1,7 +1,7 @@
-      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
-     * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
-     * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
-     * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
-c
+      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
+     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
+     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
+     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
+!c
       INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
       REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
Index: trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90
===================================================================
--- trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90	(revision 1403)
@@ -0,0 +1,590 @@
+MODULE filtreg_mod
+
+CONTAINS
+
+      SUBROUTINE inifilr
+!
+!    ... H. Upadhyaya, O.Sharma   ...
+!
+      IMPLICIT NONE
+!
+!     version 3 .....
+
+!     Correction  le 28/10/97    P. Le Van .
+!  -------------------------------------------------------------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "parafilt.h"
+!  -------------------------------------------------------------------
+#include "comgeom.h"
+#include "coefils.h"
+#include "logic.h"
+#include "serre.h"
+
+      REAL  dlonu(iim),dlatu(jjm)
+      REAL  rlamda( iim ),  eignvl( iim )
+!
+
+      REAL    lamdamax,pi,cof
+      INTEGER i,j,modemax,imx,k,kf,ii
+      REAL dymin,dxmin,colat0
+      REAL eignft(iim,iim), coff
+      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs 
+      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus) &
+                   , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs) &
+                   ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
+#ifdef CRAY
+      INTEGER   ISMIN
+      EXTERNAL  ISMIN
+      INTEGER iymin 
+      INTEGER ixmineq
+#endif
+      EXTERNAL  inifgn
+!
+! ------------------------------------------------------------
+!   This routine computes the eigenfunctions of the laplacien
+!   on the stretched grid, and the filtering coefficients
+!      
+!  We designate:
+!   eignfn   eigenfunctions of the discrete laplacien
+!   eigenvl  eigenvalues
+!   jfiltn   indexof the last scalar line filtered in NH
+!   jfilts   index of the first line filtered in SH
+!   modfrst  index of the mode from where modes are filtered
+!   modemax  maximum number of modes ( im )
+!   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
+!   sdd      SQRT( dx )
+!      
+!     the modes are filtered from modfrst to modemax
+      
+!-----------------------------------------------------------
+!
+
+       pi       = 2. * ASIN( 1. )
+
+       DO i = 1,iim
+        dlonu(i) = xprimu( i )
+       ENDDO
+!
+       CALL inifgn(eignvl)
+!
+        print *,' EIGNVL '
+        PRINT 250,eignvl
+250     FORMAT( 1x,5e13.6)
+!
+! compute eigenvalues and eigenfunctions
+!
+!
+!.................................................................
+!
+!  compute the filtering coefficients for scalar lines and 
+!  meridional wind v-lines
+!
+!  we filter all those latitude lines where coefil < 1
+!  NO FILTERING AT POLES
+!
+!  colat0 is to be used  when alpha (stretching coefficient)
+!  is set equal to zero for the regular grid case 
+!
+!    .......   Calcul  de  colat0   .........
+!     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
+!
+!
+      DO 45 j = 1,jjm
+         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
+ 45   CONTINUE
+!
+#ifdef CRAY
+      iymin   = ISMIN( jjm, dlatu, 1 )
+      ixmineq = ISMIN( iim, dlonu, 1 )
+      dymin   = dlatu( iymin )
+      dxmin   = dlonu( ixmineq )
+#else
+      dxmin   =  dlonu(1)
+       DO  i  = 2, iim
+        dxmin = MIN( dxmin,dlonu(i) )
+       ENDDO
+      dymin  = dlatu(1)
+       DO j  = 2, jjm
+        dymin = MIN( dymin,dlatu(j) )
+       ENDDO
+#endif
+!
+!
+      colat0  =  MIN( 0.5, dymin/dxmin )
+!
+      IF( .NOT.fxyhypb.AND.ysinus )  THEN
+           colat0 = 0.6
+!         ...... a revoir  pour  ysinus !   .......
+           alphax = 0.
+      ENDIF
+!
+      PRINT 50, colat0,alphax
+  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
+!
+      IF(alphax.EQ.1. )  THEN
+        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
+         STOP
+      ENDIF
+!
+      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
+
+!c                        ... Correction  le 28/10/97  ( P.Le Van ) ..
+!
+      DO 71 i = 2,iim
+       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
+ 71   CONTINUE
+!
+
+      DO 72 j = 1,jjm
+	    DO 73 i = 1,iim
+	    coefilu( i,j )  = 0.0
+	    coefilv( i,j )  = 0.0
+	    coefilu2( i,j ) = 0.0
+	    coefilv2( i,j ) = 0.0
+ 73     CONTINUE
+ 72   CONTINUE
+
+!
+!    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
+!    .........................................................
+!
+       modemax = iim
+
+!ccc    imx = modemax - 4 * (modemax/iim)
+
+       imx  = iim
+!
+       PRINT *,' TRUNCATION AT ',imx
+!
+      DO 75 j = 2, jjm/2+1
+       cof = COS( rlatu(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
+        ENDIF
+
+       cof = COS( rlatu(jjp1-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) &
+            jfiltsu= jjp1-j+1
+        ENDIF
+ 75   CONTINUE
+!
+      DO 76 j = 1, jjm/2
+       cof = COS( rlatv(j) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
+        ENDIF
+
+       cof = COS( rlatv(jjm-j+1) )/ colat0
+	    IF ( cof .LT. 1. ) THEN
+          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) &
+             jfiltsv= jjm-j+1
+        ENDIF
+ 76   CONTINUE
+!                                 
+
+      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
+        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
+        STOP
+      ENDIF
+
+      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
+        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
+        STOP
+      ENDIF
+
+      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
+        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
+        STOP
+      ENDIF
+
+      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
+        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
+        STOP
+      ENDIF
+
+       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' , &
+                 jfiltnv,jfiltsv,jfiltnu,jfiltsu
+
+!                                 
+!   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
+!................................................................
+!
+!
+      DO 77 j = 1,jjm
+	  modfrstu( j ) = iim
+	  modfrstv( j ) = iim
+ 77   CONTINUE
+!
+      DO 84 j = 2,jfiltnu
+       DO 81 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 82
+ 81    CONTINUE
+      GOTO 84
+ 82   modfrstu( j ) = k
+!
+	  kf = modfrstu( j )
+	   DO 83 k = kf , modemax
+        cof = rlamda(k) * COS( rlatu(j) )
+	    coefilu(k,j) = cof - 1.
+	    coefilu2(k,j) = cof*cof - 1.
+ 83    CONTINUE
+ 84   CONTINUE
+!                                 
+!
+      DO 89 j = 1,jfiltnv
+!
+       DO 86 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 87
+ 86    CONTINUE
+      GOTO 89
+ 87   modfrstv( j ) = k
+!
+	   kf = modfrstv( j )
+	   DO 88 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 88    CONTINUE
+!
+ 89    CONTINUE
+!
+      DO 94 j = jfiltsu,jjm
+       DO 91 k = 2,modemax
+	    cof = rlamda(k) * COS( rlatu(j) )
+         IF ( cof .LT. 1. ) GOTO 92
+ 91    CONTINUE
+      GOTO 94
+ 92   modfrstu( j ) = k
+!
+        kf = modfrstu( j )
+	 DO 93 k = kf , modemax
+          cof = rlamda(k) * COS( rlatu(j) )
+	  coefilu(k,j) = cof - 1.
+	  coefilu2(k,j) = cof*cof - 1.
+ 93      CONTINUE
+ 94    CONTINUE
+!                                 
+      DO 99 j = jfiltsv,jjm
+       DO 96 k = 2,modemax
+	     cof = rlamda(k) * COS( rlatv(j) )
+         IF ( cof .LT. 1. ) GOTO 97
+ 96    CONTINUE
+      GOTO 99
+ 97   modfrstv( j ) = k
+!
+       kf = modfrstv( j )
+	   DO 98 k = kf , modemax
+        cof = rlamda(k) * COS( rlatv(j) )
+	    coefilv(k,j) = cof - 1.
+	    coefilv2(k,j) = cof*cof - 1.
+ 98    CONTINUE
+ 99   CONTINUE
+!
+
+       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
+
+         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
+         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
+
+          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , &
+              jfiltnv,jfiltsv,jfiltnu,jfiltsu
+       ENDIF
+
+       PRINT *,'   Modes premiers  v  '
+       PRINT 334,modfrstv
+       PRINT *,'   Modes premiers  u  '
+       PRINT 334,modfrstu
+
+     
+      IF( nfilun.LT. jfiltnu )  THEN
+       PRINT *,' le parametre nfilun utilise pour la matrice ', &
+         ' matriceun  est trop petit ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilun.GT. jfiltnu+ 2 )  THEN
+           PRINT *,' le parametre nfilun utilise pour la matrice ', &
+      ' matriceun est trop grand ! Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
+        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
+            PRINT *,' le parametre nfilus utilise pour la matrice ', &
+         ' matriceus  est trop petit !  '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ', &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
+           PRINT *,' le parametre nfilus utilise pour la matrice ', &
+       ' matriceus  est trop grand ! ' 
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' , &
+       jjm - jfiltsu + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvn.LT. jfiltnv )  THEN
+            PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+         ' matricevn  est trop petit ! '  
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
+           PRINT *,' le parametre nfilvn utilise pour la matrice ', &
+      ' matricevn est trop grand !  Gachis de memoire ! ' 
+       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
+            PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+         ' matricevs  est trop petit !  Le changer dans parafilt.h '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+       , jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+               STOP
+      ENDIF
+      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
+           PRINT *,' le parametre nfilvs utilise pour la matrice ', &
+       ' matricevs  est trop grand ! Gachis de memoire ! '
+       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
+         ,  jjm - jfiltsv + 1
+        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
+       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
+        ,jfiltnv,jjm-jfiltsv+1
+!              STOP
+      ENDIF
+
+!  
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
+!                       sur la grille scalaire                 ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
+#else
+#ifdef BLAS
+         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+         eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceun(i,k,j) = 0.0
+            DO ii = 1, iim
+               matriceun(i,k,j) = matriceun(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i=1,iim
+          coff = coefilu(i,j)
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnv, iim, eignft, iim, 0.0, &
+                 matriceus(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matriceus(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1) &
+                                          + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
+!                       sur la grille   de V ou de Z           ........
+!   ...................................................................
+!
+        DO j = 1, jfiltnv
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+           DO k = 1, iim
+            eignft(i,k) = eignfnu(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matricevn(i,k,j) = matricevn(i,k,j) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsv, jjm
+
+         DO i = 1, iim
+          coff = coefilv(i,j)
+          IF( i.LT.modfrstv(j) ) coff = 0.
+            DO k = 1, iim
+             eignft(i,k) = eignfnu(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+                 eignfnu, iim, eignft, iim, 0.0, &
+                 matricevs(1,1,j-jfiltsv+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matricevs(i,k,j-jfiltsv+1) = 0.0
+            DO ii = 1, iim
+               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1) &
+                                + eignfnu(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+!
+!   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
+!              sur la grille scalaire , pour le filtre inverse ........
+!   ...................................................................
+!
+        DO j = 2, jfiltnu
+
+         DO i = 1,iim
+          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+           DO k=1,iim
+            eignft(i,k) = eignfnv(k,i) * coff
+           ENDDO
+         ENDDO
+#ifdef CRAY
+          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+           eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvn(i,k,j) = 0.0
+            DO ii = 1, iim
+               matrinvn(i,k,j) = matrinvn(i,k,j) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+        DO j = jfiltsu, jjm
+
+         DO i = 1,iim
+          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
+          IF( i.LT.modfrstu(j) ) coff = 0.
+            DO k=1,iim
+             eignft(i,k) = eignfnv(k,i) * coff
+            ENDDO
+         ENDDO
+#ifdef CRAY
+         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
+#else
+#ifdef BLAS
+      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
+       eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
+#else
+         DO k = 1, iim
+         DO i = 1, iim
+            matrinvs(i,k,j-jfiltsu+1) = 0.0
+            DO ii = 1, iim
+               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1) &
+                                + eignfnv(i,ii)*eignft(ii,k)
+            ENDDO
+         ENDDO
+         ENDDO
+#endif
+#endif
+
+        ENDDO
+
+!   ...................................................................
+
+!
+334    FORMAT(1x,24i3)
+755    FORMAT(1x,6f10.3,i3)
+
+       RETURN
+       END SUBROUTINE inifilr
+
+END MODULE  filtreg_mod
Index: trunk/LMDZ.MARS/libf/filtrez/inifilr.F
===================================================================
--- trunk/LMDZ.MARS/libf/filtrez/inifilr.F	(revision 1399)
+++ 	(revision )
@@ -1,584 +1,0 @@
-      SUBROUTINE inifilr
-c
-c    ... H. Upadhyaya, O.Sharma   ...
-c
-      IMPLICIT NONE
-c
-c     version 3 .....
-
-c     Correction  le 28/10/97    P. Le Van .
-c  -------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "parafilt.h"
-c  -------------------------------------------------------------------
-#include "comgeom.h"
-#include "coefils.h"
-#include "logic.h"
-#include "serre.h"
-
-      REAL  dlonu(iim),dlatu(jjm)
-      REAL  rlamda( iim ),  eignvl( iim )
-c
-
-      REAL    lamdamax,pi,cof
-      INTEGER i,j,modemax,imx,k,kf,ii
-      REAL dymin,dxmin,colat0
-      REAL eignft(iim,iim), coff
-      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
-      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
-     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
-     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
-#ifdef CRAY
-      INTEGER   ISMIN
-      EXTERNAL  ISMIN
-      INTEGER iymin 
-      INTEGER ixmineq
-#endif
-      EXTERNAL  inifgn
-c
-c ------------------------------------------------------------
-c   This routine computes the eigenfunctions of the laplacien
-c   on the stretched grid, and the filtering coefficients
-c      
-c  We designate:
-c   eignfn   eigenfunctions of the discrete laplacien
-c   eigenvl  eigenvalues
-c   jfiltn   indexof the last scalar line filtered in NH
-c   jfilts   index of the first line filtered in SH
-c   modfrst  index of the mode from where modes are filtered
-c   modemax  maximum number of modes ( im )
-c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
-c   sdd      SQRT( dx )
-c      
-c     the modes are filtered from modfrst to modemax
-c      
-c-----------------------------------------------------------
-c
-
-       pi       = 2. * ASIN( 1. )
-
-       DO i = 1,iim
-        dlonu(i) = xprimu( i )
-       ENDDO
-c
-       CALL inifgn(eignvl)
-c
-        print *,' EIGNVL '
-        PRINT 250,eignvl
-250     FORMAT( 1x,5e13.6)
-c
-c compute eigenvalues and eigenfunctions
-c
-c
-c.................................................................
-c
-c  compute the filtering coefficients for scalar lines and 
-c  meridional wind v-lines
-c
-c  we filter all those latitude lines where coefil < 1
-c  NO FILTERING AT POLES
-c
-c  colat0 is to be used  when alpha (stretching coefficient)
-c  is set equal to zero for the regular grid case 
-c
-c    .......   Calcul  de  colat0   .........
-c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
-c
-c
-      DO 45 j = 1,jjm
-         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
- 45   CONTINUE
-c
-#ifdef CRAY
-      iymin   = ISMIN( jjm, dlatu, 1 )
-      ixmineq = ISMIN( iim, dlonu, 1 )
-      dymin   = dlatu( iymin )
-      dxmin   = dlonu( ixmineq )
-#else
-      dxmin   =  dlonu(1)
-       DO  i  = 2, iim
-        dxmin = MIN( dxmin,dlonu(i) )
-       ENDDO
-      dymin  = dlatu(1)
-       DO j  = 2, jjm
-        dymin = MIN( dymin,dlatu(j) )
-       ENDDO
-#endif
-c
-c
-      colat0  =  MIN( 0.5, dymin/dxmin )
-c
-      IF( .NOT.fxyhypb.AND.ysinus )  THEN
-           colat0 = 0.6
-c         ...... a revoir  pour  ysinus !   .......
-           alphax = 0.
-      ENDIF
-c
-      PRINT 50, colat0,alphax
-  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
-c
-      IF(alphax.EQ.1. )  THEN
-        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
-         STOP
-      ENDIF
-c
-      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
-
-cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
-c
-      DO 71 i = 2,iim
-       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
- 71   CONTINUE
-c
-
-      DO 72 j = 1,jjm
-	    DO 73 i = 1,iim
-	    coefilu( i,j )  = 0.0
-	    coefilv( i,j )  = 0.0
-	    coefilu2( i,j ) = 0.0
-	    coefilv2( i,j ) = 0.0
- 73     CONTINUE
- 72   CONTINUE
-
-c
-c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
-c    .........................................................
-c
-       modemax = iim
-
-cccc    imx = modemax - 4 * (modemax/iim)
-
-       imx  = iim
-c
-       PRINT *,' TRUNCATION AT ',imx
-c
-      DO 75 j = 2, jjm/2+1
-       cof = COS( rlatu(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
-        ENDIF
-
-       cof = COS( rlatu(jjp1-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
-     $      jfiltsu= jjp1-j+1
-        ENDIF
- 75   CONTINUE
-c
-      DO 76 j = 1, jjm/2
-       cof = COS( rlatv(j) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
-        ENDIF
-
-       cof = COS( rlatv(jjm-j+1) )/ colat0
-	    IF ( cof .LT. 1. ) THEN
-          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
-     $       jfiltsv= jjm-j+1
-        ENDIF
- 76   CONTINUE
-c                                 
-
-      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
-        PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu
-        STOP
-      ENDIF
-
-      IF( jfiltsu.LE.0 .OR. jfiltsu.GT.  jjm  +1 )  THEN
-        PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu
-        STOP
-      ENDIF
-
-      IF( jfiltnv.LE.0 .OR. jfiltnv.GT. jjm/2    )  THEN
-        PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv
-        STOP
-      ENDIF
-
-      IF( jfiltsv.LE.0 .OR. jfiltsv.GT.     jjm  )  THEN
-        PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv
-        STOP
-      ENDIF
-
-       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
-     *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
-
-c                                 
-c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
-c................................................................
-c
-c
-      DO 77 j = 1,jjm
-	  modfrstu( j ) = iim
-	  modfrstv( j ) = iim
- 77   CONTINUE
-c
-      DO 84 j = 2,jfiltnu
-       DO 81 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 82
- 81    CONTINUE
-      GOTO 84
- 82   modfrstu( j ) = k
-c
-	  kf = modfrstu( j )
-	   DO 83 k = kf , modemax
-        cof = rlamda(k) * COS( rlatu(j) )
-	    coefilu(k,j) = cof - 1.
-	    coefilu2(k,j) = cof*cof - 1.
- 83    CONTINUE
- 84   CONTINUE
-c                                 
-c
-      DO 89 j = 1,jfiltnv
-c
-       DO 86 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 87
- 86    CONTINUE
-      GOTO 89
- 87   modfrstv( j ) = k
-c
-	   kf = modfrstv( j )
-	   DO 88 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 88    CONTINUE
-c
- 89    CONTINUE
-c
-      DO 94 j = jfiltsu,jjm
-       DO 91 k = 2,modemax
-	    cof = rlamda(k) * COS( rlatu(j) )
-         IF ( cof .LT. 1. ) GOTO 92
- 91    CONTINUE
-      GOTO 94
- 92   modfrstu( j ) = k
-c
-        kf = modfrstu( j )
-	 DO 93 k = kf , modemax
-          cof = rlamda(k) * COS( rlatu(j) )
-	  coefilu(k,j) = cof - 1.
-	  coefilu2(k,j) = cof*cof - 1.
- 93      CONTINUE
- 94    CONTINUE
-c                                 
-      DO 99 j = jfiltsv,jjm
-       DO 96 k = 2,modemax
-	     cof = rlamda(k) * COS( rlatv(j) )
-         IF ( cof .LT. 1. ) GOTO 97
- 96    CONTINUE
-      GOTO 99
- 97   modfrstv( j ) = k
-c
-       kf = modfrstv( j )
-	   DO 98 k = kf , modemax
-        cof = rlamda(k) * COS( rlatv(j) )
-	    coefilv(k,j) = cof - 1.
-	    coefilv2(k,j) = cof*cof - 1.
- 98    CONTINUE
- 99   CONTINUE
-c
-
-       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
-
-         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
-         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
-
-          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
-     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
-       ENDIF
-
-       PRINT *,'   Modes premiers  v  '
-       PRINT 334,modfrstv
-       PRINT *,'   Modes premiers  u  '
-       PRINT 334,modfrstu
-
-     
-      IF( nfilun.LT. jfiltnu )  THEN
-       PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *   ' matriceun  est trop petit ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilun.GT. jfiltnu+ 2 )  THEN
-           PRINT *,' le parametre nfilun utilise pour la matrice ',
-     *' matriceun est trop grand ! Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
-        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
-            PRINT *,' le parametre nfilus utilise pour la matrice ',
-     *   ' matriceus  est trop petit !  '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ',
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
-           PRINT *,' le parametre nfilus utilise pour la matrice ',
-     * ' matriceus  est trop grand ! ' 
-       PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
-     * jjm - jfiltsu + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvn.LT. jfiltnv )  THEN
-            PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *   ' matricevn  est trop petit ! '  
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
-           PRINT *,' le parametre nfilvn utilise pour la matrice ',
-     *' matricevn est trop grand !  Gachis de memoire ! ' 
-       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
-            PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     * , jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-               STOP
-      ENDIF
-      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
-           PRINT *,' le parametre nfilvs utilise pour la matrice ',
-     * ' matricevs  est trop grand ! Gachis de memoire ! '
-       PRINT *,' Le changer dans parafilt.h et le mettre a  '
-     *   ,  jjm - jfiltsv + 1
-        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
-     * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
-     *  ,jfiltnv,jjm-jfiltsv+1
-c              STOP
-      ENDIF
-
-c  
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
-c                       sur la grille scalaire                 ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM( eignfnv,iim,eignft,iim,matriceun(1,1,j),iim )
-#else
-#ifdef BLAS
-         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceun(i,k,j) = 0.0
-            DO ii = 1, iim
-               matriceun(i,k,j) = matriceun(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i=1,iim
-          coff = coefilu(i,j)
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matriceus(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnv, iim, eignft, iim, 0.0, 
-     $           matriceus(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matriceus(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
-     .                                    + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
-c                       sur la grille   de V ou de Z           ........
-c   ...................................................................
-c
-        DO j = 1, jfiltnv
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-           DO k = 1, iim
-            eignft(i,k) = eignfnu(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnu,iim,eignft,iim,matricevn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matricevn(i,k,j) = matricevn(i,k,j)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsv, jjm
-
-         DO i = 1, iim
-          coff = coefilv(i,j)
-          IF( i.LT.modfrstv(j) ) coff = 0.
-            DO k = 1, iim
-             eignft(i,k) = eignfnu(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnu,iim,eignft,iim,matricevs(1,1,j-jfiltsv+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $           eignfnu, iim, eignft, iim, 0.0, 
-     $           matricevs(1,1,j-jfiltsv+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matricevs(i,k,j-jfiltsv+1) = 0.0
-            DO ii = 1, iim
-               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
-     .                          + eignfnu(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-c
-c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
-c              sur la grille scalaire , pour le filtre inverse ........
-c   ...................................................................
-c
-        DO j = 2, jfiltnu
-
-         DO i = 1,iim
-          coff = coefilu(i,j)/ ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-           DO k=1,iim
-            eignft(i,k) = eignfnv(k,i) * coff
-           ENDDO
-         ENDDO
-#ifdef CRAY
-          CALL MXM( eignfnv,iim,eignft,iim,matrinvn(1,1,j),iim )
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvn(i,k,j) = 0.0
-            DO ii = 1, iim
-               matrinvn(i,k,j) = matrinvn(i,k,j)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-        DO j = jfiltsu, jjm
-
-         DO i = 1,iim
-          coff = coefilu(i,j) / ( 1. + coefilu(i,j) )
-          IF( i.LT.modfrstu(j) ) coff = 0.
-            DO k=1,iim
-             eignft(i,k) = eignfnv(k,i) * coff
-            ENDDO
-         ENDDO
-#ifdef CRAY
-         CALL MXM(eignfnv,iim,eignft,iim,matrinvs(1,1,j-jfiltsu+1),iim)
-#else
-#ifdef BLAS
-      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
-     $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
-#else
-         DO k = 1, iim
-         DO i = 1, iim
-            matrinvs(i,k,j-jfiltsu+1) = 0.0
-            DO ii = 1, iim
-               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
-     .                          + eignfnv(i,ii)*eignft(ii,k)
-            ENDDO
-         ENDDO
-         ENDDO
-#endif
-#endif
-
-        ENDDO
-
-c   ...................................................................
-
-c
-334    FORMAT(1x,24i3)
-755    FORMAT(1x,6f10.3,i3)
-
-       RETURN
-       END
Index: trunk/LMDZ.MARS/libf/filtrez/parafilt.h
===================================================================
--- trunk/LMDZ.MARS/libf/filtrez/parafilt.h	(revision 1399)
+++ trunk/LMDZ.MARS/libf/filtrez/parafilt.h	(revision 1403)
@@ -1,40 +1,40 @@
         INTEGER nfilun, nfilus, nfilvn, nfilvs
-c
-c 48 32 19 non-zoom:
-c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
-c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
-c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
-c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
-cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
-c
-c
-c 96 49 11 non-zoom:
-ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
-c
-c
-c 144 73 11 non-zoom:
-ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
-c
-c 192 143 19 non-zoom:
-c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
-c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
-c      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
+!
+! 48 32 19 non-zoom:
+!       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
+!        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
+!         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
+!        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
+!maf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
+!
+!
+! 96 49 11 non-zoom:
+!cc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
+!
+!
+! 144 73 11 non-zoom:
+!cc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
+!
+! 192 143 19 non-zoom:
+!             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
+!      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
+!      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
 !!        PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
         PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
-c 96 72 19 non-zoom:
-ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
-c
-c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
-c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
-c
-c
-c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
-c
-c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
-c
-c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
-c
-c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
-c
-c      Parameter  ci-dessus  et de relancer  le  run .  
+! 96 72 19 non-zoom:
+!cc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
+!
+!        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
+!       PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
+!
+!
+!      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
+!
+!      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
+!
+!      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et 
+!
+!      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
+!
+!      Parameter  ci-dessus  et de relancer  le  run .  
 
Index: trunk/LMDZ.MARS/libf/misc/cbrt.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/cbrt.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/cbrt.F	(revision 1403)
@@ -0,0 +1,9 @@
+      FUNCTION cbrt(x)
+      IMPLICIT NONE
+
+      REAL x,cbrt
+
+      cbrt=sign(1.,x)*(abs(x)**(1./3.))
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/misc/cvmgp.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/cvmgp.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/cvmgp.F	(revision 1403)
@@ -0,0 +1,14 @@
+      FUNCTION cvmgp(x1,x2,x3)
+      IMPLICIT NONE
+
+      REAL x1,x2,x3,cvmgp
+
+      IF(x3.ge.0) then 
+        cvmgp=x1
+      ELSE
+        cvmgp=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/LMDZ.MARS/libf/misc/cvmgt.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/cvmgt.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/cvmgt.F	(revision 1403)
@@ -0,0 +1,15 @@
+      FUNCTION cvmgt(x1,x2,l)
+      IMPLICIT NONE
+
+      REAL x1,x2,cvmgt
+      LOGICAL l
+
+      IF(l) then 
+        cvmgt=x1
+      ELSE
+        cvmgt=x2
+      ENDIF
+
+      RETURN
+      END
+C
Index: trunk/LMDZ.MARS/libf/misc/from36.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/from36.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/from36.F	(revision 1403)
@@ -0,0 +1,111 @@
+      SUBROUTINE from36(x,nbre,iunit)
+      IMPLICIT NONE
+c====================================================================
+      INTEGER iunit, nbre
+      REAL x(nbre)
+c====================================================================
+      INTEGER i, l
+      INTEGER nbreok, ibaseok, icase
+      REAL xmax, xmin, errcod
+c====================================================================
+      INTEGER lbord
+      PARAMETER (lbord=255)
+      REAL conv(0:lbord)
+c====================================================================     
+      INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxcas=3, maxnbr=100000)
+      PARAMETER(ifact1=ibase**1-1)
+      PARAMETER(ifact2=ibase**2-1)
+      PARAMETER(ifact3=ibase**3-1)
+      CHARACTER*1 base(ibase), fac(maxcas,maxnbr)
+      INTEGER inte(maxcas)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c====================================================================
+      IF (nbre .GT. maxnbr) THEN
+      PRINT*, 'Verifier maxnbr dans from36 (trop petite)'
+      STOP
+      ENDIF
+      DO 10 i = 0, lbord
+   10 conv(i) = 1.0e+33
+c    34  c  10 conv(i) = 1.0e+49
+      DO 20 i = 1, ibase
+      l = ICHAR(base(i))
+   20 conv(l) = FLOAT(i-1)
+c====================================================================
+      READ (iunit,*) nbreok, ibaseok, icase
+        IF (nbre .NE. nbreok) THEN
+          PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre
+          STOP
+        ENDIF
+        IF (ibase .NE. ibaseok) THEN
+          PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase
+          STOP
+        ENDIF
+        IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN
+          PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire', 
+     .             icase
+          STOP
+        ENDIF
+c====================================================================
+      READ (iunit,*) xmin
+      READ (iunit,*) xmax
+        PRINT*,'Xmin et Xmax=', xmin, xmax
+c====================================================================
+      IF (xmin .EQ. xmax) THEN
+        READ(iunit,'(a)')
+        PRINT*, 'Ce champ est constant'
+        DO 30 i = 1, nbre
+   30   x(i) = xmin
+        GO TO 123
+      END IF
+c====================================================================
+      IF (icase .EQ. 1) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact1)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 190 i = 1, nbre
+        x(i) = 0.0
+        DO 191 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  191   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin)
+  190   CONTINUE
+      ELSE IF (icase .EQ. 2) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact2)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 290 i = 1, nbre
+        x(i) = 0.0
+        DO 291 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  291   CONTINUE
+        x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin)
+  290   CONTINUE
+      ELSE IF (icase .EQ. 3) THEN
+        errcod = (xmax-xmin) / FLOAT(ifact3)
+        PRINT*,'La precision du codage est entre + / - ', errcod
+        READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre)
+        DO 390 i = 1, nbre
+        x(i) = 0.0
+        DO 391 l = 1, icase
+        inte(l) = ICHAR( fac(l,i) )
+        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
+  391   CONTINUE
+        x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin)
+  390   CONTINUE
+      ELSE
+        PRINT*, 'Verfier icase (1, 2 ou 3)'
+        STOP
+      ENDIF
+   91 FORMAT(120a1)
+   92 FORMAT(64(2a1))
+   93 FORMAT(40(3a1))
+c====================================================================
+  123 RETURN
+      END
Index: trunk/LMDZ.MARS/libf/misc/gather.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/gather.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/gather.F	(revision 1403)
@@ -0,0 +1,16 @@
+      SUBROUTINE GATHER(n,a,b,index)
+c
+      IMPLICIT NONE
+C
+      INTEGER n,index(n),i
+      REAL a(n),b(n)
+c
+      DO 100 i=1,n
+        a(i)=b(index(i))
+100   CONTINUE
+c
+      RETURN
+      END
+c
+c     voir aussi vec_gather(v,vindices,count,r)...p.11-14
+c  
Index: trunk/LMDZ.MARS/libf/misc/ilsum.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ilsum.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ilsum.F	(revision 1403)
@@ -0,0 +1,19 @@
+      FUNCTION ilsum(n, logic, inc)
+c
+      IMPLICIT NONE
+c
+      integer ilsum
+      integer n, inc
+      logical logic((n-1)*inc+1)
+c
+      integer i, in
+c
+      ilsum = 0.
+      in = 1
+      do 10 i = 1, n
+         if (logic(in)) ilsum = ilsum + 1
+         in=in+inc
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/ini36.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ini36.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ini36.F	(revision 1403)
@@ -0,0 +1,46 @@
+      SUBROUTINE ini36
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c====================================================================
+c-- cette routine fait l'initialisation pour le codage sur base 36
+c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases
+      INTEGER i,j,k,l, ijk, jk
+c====================================================================
+      INTEGER ibase, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36)
+      PARAMETER (ifact1 = ibase-1)
+      PARAMETER (ifact2 = ibase*ibase-1)
+      PARAMETER (ifact3 = ibase*ibase*ibase-1)
+c====================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+c====================================================================
+      CHARACTER*1 base(ibase)
+      DATA (base(l),l=1,ibase)
+     .     /'0','1','2','3','4','5','6','7','8','9',
+     .      'A','B','C','D','E','F','G','H','I','J',
+     .      'K','L','M','N','O','P','Q','R','S','T',
+     .      'U','V','W','X','Y','Z'/
+c===================================================================
+      DO 30 i = 1, ibase
+      DO 30 j = 1, ibase
+      DO 30 k = 1, ibase
+      ijk = ( (i-1)*ibase + j-1 )*ibase + k-1
+      word3(ijk) = base(i)//base(j)//base(k)
+   30 CONTINUE
+      DO 20 j = 1, ibase
+      DO 20 k = 1, ibase
+      jk = (j-1)*ibase + k-1
+      word2(jk) = base(j)//base(k)
+   20 CONTINUE
+      DO 10 k = 1, ibase
+      word1(k-1) = base(k)
+   10 CONTINUE
+c===================================================================
+      RETURN
+      END
+
Index: trunk/LMDZ.MARS/libf/misc/iniprint.h
===================================================================
--- trunk/LMDZ.MARS/libf/misc/iniprint.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/iniprint.h	(revision 1403)
@@ -0,0 +1,11 @@
+!
+! $Id: $
+!
+!
+! handle debug and output levels
+! lunout:    unit of file where outputs will be sent
+!                           (default is 6, standard output)
+! prt_level: level of informative output messages (0 = minimum)
+!
+      INTEGER lunout, prt_level
+      COMMON /comprint/ lunout, prt_level
Index: trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ioipsl_errioipsl.F90	(revision 1403)
@@ -0,0 +1,219 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE ioipsl_errioipsl
Index: trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ioipsl_getincom.F90	(revision 1403)
@@ -0,0 +1,1980 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_getincom
+!-
+!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE ioipsl_errioipsl, ONLY : ipslerr
+USE ioipsl_stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the run.def file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the run.def file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from run.def
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = 'run.def'
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file='run.def.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of run.def and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE ioipsl_getincom
Index: trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ioipsl_stringop.F90	(revision 1403)
@@ -0,0 +1,243 @@
+!
+! $Id$
+!
+! Module/Routines extracted from IOIPSL v2_1_8
+!
+MODULE ioipsl_stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE ioipsl_stringop
Index: trunk/LMDZ.MARS/libf/misc/isamax.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/isamax.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/isamax.F	(revision 1403)
@@ -0,0 +1,21 @@
+      function isamax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,isamax,ix
+      real sx((n-1)*incx+1),sxmax,abssx
+c
+      ix=1
+      isamax=1
+      sxmax=ABS(sx(1))
+      do 10 i=1,n-1
+         ix=ix+incx
+         abssx=ABS(sx(ix))
+         if(abssx.gt.sxmax) then
+             sxmax=abssx
+             isamax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/isitor.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/isitor.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/isitor.F	(revision 1403)
@@ -0,0 +1,64 @@
+
+      SUBROUTINE isitor(filename,writeornot,filenum, files)
+
+C--------------------------------------------------------------------
+C Subroutine qui determine si un fichier doit etre ecrit ou non
+C--------------------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     filename: CHARACTER*20 
+C               nom du fichier dont on veut savoir si il doit etre ecrit
+C     writeornot: LOGICAL
+C                 Variable de sortie qui est vraie si le champ doit etre ecrit
+C     filenum: INTEGER
+C              nombre de fichier dans la list files
+C     files: CHARACTER*20 files(100)
+C            c'est la liste des fichier qui doivent etre ecrit et dans
+C            lequel on vas voir si filename y est.
+C
+
+
+      IMPLICIT NONE
+      CHARACTER*20 filename, checkname
+      CHARACTER*1 separator
+      LOGICAL writeornot, check
+      INTEGER iletter, ifile
+      INTEGER filenum
+      CHARACTER*20 files(100)
+
+      writeornot = .FALSE.
+      check = .FALSE.
+      separator = '/'
+
+      DO 6565 iletter = 20,1,-1
+
+        IF (filename(iletter:iletter) .EQ. separator) THEN
+
+          checkname = filename(iletter+1:20)
+    
+        ELSE
+        ENDIF
+ 6565 CONTINUE
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: filename=',filename,
+     &             'checkname=',checkname
+      ENDIF
+
+      DO 6767 ifile = 1,filenum
+
+      IF (files(ifile) .EQ. checkname ) THEN
+       
+      writeornot = .TRUE. 
+
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'ISITORNOT:: writeornot=',writeornot
+      ENDIF
+
+ 6767 CONTINUE
+
+      RETURN
+      END
+
Index: trunk/LMDZ.MARS/libf/misc/ismax.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ismax.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ismax.F	(revision 1403)
@@ -0,0 +1,20 @@
+      function ismax(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      INTEGER n,i,incx,ismax,ix
+      real sx((n-1)*incx+1),sxmax
+c
+      ix=1
+      ismax=1
+      sxmax=sx(1)
+      do 10 i=1,n-1
+      ix=ix+incx
+      if(sx(ix).gt.sxmax) then
+      sxmax=sx(ix)
+      ismax=i+1
+         endif
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/ismin.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ismin.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ismin.F	(revision 1403)
@@ -0,0 +1,20 @@
+      FUNCTION ismin(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,i,incx,ismin,ix
+      real sx((n-1)*incx+1),sxmin
+c
+      ix=1
+      ismin=1
+      sxmin=sx(1)
+      DO i=1,n-1
+	 ix=ix+incx
+	 if(sx(ix).lt.sxmin) then
+	     sxmin=sx(ix)
+	     ismin=i+1
+         endif
+      ENDDO
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/lmdstd.h
===================================================================
--- trunk/LMDZ.MARS/libf/misc/lmdstd.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/lmdstd.h	(revision 1403)
@@ -0,0 +1,31 @@
+c=======================================================================
+c   INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+
+      INTEGER bandmax
+      PARAMETER(bandmax=24)
+
+      COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+     $                gentete,gdatedep,gdatefin
+        
+      CHARACTER*100 gtitre    !du champ
+      CHARACTER*20  gunites   !unites du champ
+      CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+      CHARACTER*100 gfichier  !nom du fichier contenant le champ
+      CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+      CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+      CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+      CHARACTER*20  glistfich !liste de champs a sortir
+
+      COMMON/lmdstdnu/ gminimum,gmaximum,
+     $                 gdeltajour(bandmax),gdeltapas(bandmax),
+     $                 gnbetats(bandmax),gnbfich
+
+      REAL    gminimum        ! \    min et max
+      REAL    gmaximum        ! /    du champ
+      INTEGER gnbfich         ! nombre de fichier a sortir
+c  pour les evolutions temporelles:
+      INTEGER gnbetats        ! nombre d'etats par bande
+      INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+      REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+
+c=======================================================================
Index: trunk/LMDZ.MARS/libf/misc/lnblnk.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/lnblnk.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/lnblnk.F	(revision 1403)
@@ -0,0 +1,36 @@
+      INTEGER FUNCTION lnblnk (letter)
+
+C--------------------------------------------------------
+C Fonction qui determine la longeur d'un string sans les
+C blancs qui suivent. Le critere pour determiner la fin du
+C string est, trois blancs de suite
+C---------------------------------------------------------
+C     ARGUMENTS
+C     +++++++++
+C     letter: CHARACTER*xxx (xxx < imax)
+C             le string dont on determine la longuer
+C     lnblnk: INTEGER
+C             le nombre de characteres
+C
+C     PARAMETER
+C     +++++++++
+C     imax : INTEGER
+C            le nombre maximale de character que peut contenir le string
+C            a traiter
+
+      IMPLICIT NONE
+      INTEGER i,imax
+      PARAMETER (imax = 256)
+      CHARACTER*256 letter
+
+      i=0
+
+10    i=i+1
+      IF (letter(i:i+3) . EQ . '   ') GOTO 20
+      GOTO 10
+
+20    lnblnk=i-1
+
+      RETURN
+      END
+
Index: trunk/LMDZ.MARS/libf/misc/mxm.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/mxm.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/mxm.F	(revision 1403)
@@ -0,0 +1,34 @@
+       SUBROUTINE MXM(A,NAR,B,NAC,C,NBC)
+c
+c
+c    Multiplication of matrix A by matrix B ,and result in matrix C
+c
+c
+c      NAR : number of   rows  for matrix  A and  matrix  C
+c      NAC : number of columns for matrix  A and number of rows
+c                              for matrix  B
+c      NBC : number of columns for matrix  B and  matrix  C
+c
+c
+       IMPLICIT NONE
+c
+       INTEGER  NAR,NAC,NBC, I,J,K
+       REAL     A(NAR,NAC), B(NAC,NBC), C(NAR,NBC)
+c
+       DO 10 J = 1,NBC
+       DO 10 I = 1,NAR
+       C(I,J)=0.
+10     CONTINUE
+c
+       DO 50 J = 1,NBC
+       DO 40 I = 1,NAR
+
+       DO 20 K = 1,NAC
+       C(I,J)  = C(I,J) + A(I,K) * B(K,J)
+20     CONTINUE
+
+40     CONTINUE
+50     CONTINUE
+
+       RETURN
+       END
Index: trunk/LMDZ.MARS/libf/misc/mxv.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/mxv.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/mxv.F	(revision 1403)
@@ -0,0 +1,20 @@
+      SUBROUTINE MXV(A,NRA,B,NCA,C)
+      IMPLICIT NONE
+
+      INTEGER NRA,NCA
+      REAL A(NRA,NCA), B(NCA), C(NRA)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+         C(I) = 0.
+100   CONTINUE
+c     multiply matrix A and vector B
+      DO 220 J = 1, NCA
+         DO 210 I = 1, NRA
+            C(I) = C(I) + A(I,J)*B(J)
+210     CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/misc/mxva.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/mxva.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/mxva.F	(revision 1403)
@@ -0,0 +1,25 @@
+      SUBROUTINE MXVA (SA,IAC,IAR,SB,IB,SC,IC,NRA,NCA)
+      IMPLICIT NONE
+
+      INTEGER IAC,IAR,IB,IC,NRA,NCA
+      REAL SA(*), SB(*), SC(*)
+
+      INTEGER I,J
+
+c     initialize product
+      DO 100 I = 1, NRA
+       SC( 1 + (I-1)*IC ) = 0.
+c      ( C(i) := 0. )
+100   CONTINUE
+c     multiply matrix from sa and vector from sb
+      DO 220 J = 1, NCA
+        DO 210 I = 1, NRA
+          SC( 1 + (I-1)*IC )
+     &      = SC( 1 + (I-1)*IC )
+     &        + SA( 1 + (I-1)*IAC + (J-1)*IAR )
+     &          * SB( 1 + (J-1)*IB )
+c         ( C(i) := C(i) + A(i,j)*B(j) )
+210      CONTINUE
+220   CONTINUE
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/misc/mywrite.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/mywrite.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/mywrite.F	(revision 1403)
@@ -0,0 +1,154 @@
+      SUBROUTINE mywrite(champ,icount,titre,unit,format,nom
+     &                  , entete, date0, date, deltpas, nbeta
+     &                  , deltajour, filenum, files)
+C----------------------------------------------------------
+C Subroutine qui ecrit les fichiers dans le format de transfert
+C vers le LMD.
+C format etabli par Zhao-Xin Li, Frederique Hourdin, Emmanuelle Cohen-Solal,
+C Jan Polcher . Il peut etre utilise pour sortire  des evolutions
+C temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+C le character # place devant le format determine la fin de la 
+C description du champ et permet eventulellement de rajouter
+C des informations (avant le #).
+C le programme de lecture lit , dans la description, les variables
+C qu'il connait et saute apres jusquau #. A partir de la
+C il commence a lire le champ dans le format specifie.
+c------------------------------------------------------------
+C       ARGUMENTS
+C       +++++++++
+C champ: REAL (icount)
+C        champ contenant les valeurs et de longeur icount
+C icount: INTEGER
+C         nombre d'element dans le champ
+C titre: CHARACTER*100
+C        nom d'ecrivant le champ
+C unit: CHARACTER*20
+C       unites du champ
+C format: CHARACTER*20
+C         format dans le quel le champ doit etre ecrit.
+C         au choix:
+C                  - tous les format FORTRAN
+C                  - compactage de L.Li (zxliN) ou N peut valoir 1, 2 ou 3
+C nom: CHARACTER*20
+C      nom du fichier dans le quel le champ sera ecris, eventuellement
+C      avec directory (ex: evol/tsol)
+C entete: CHARACTER*100
+C         une entete du fichier pouvant par exemple decrire le run
+C date0: CHARACTER*8
+C        date de depart de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C date : CHARACTER*8
+C        date de fin de la moyenne ou de l'evolution temporelle que contient
+C        le fichier
+C deltpas: INTEGER (bandmax)
+C          decript le nombre de pas de temps entre deux sorties pour chamque
+C          bande (necesaire pour les evolutions temporelles)
+C nbeta: INTEGER (bandmax)
+C        donne le nombre d'etas par bande (necesaire pour les evolutions 
+C        temporelles)
+C deltajour: REAL (bandmax)
+C             l'ecart en jours des iscriptions sur chaque bande (necesaire 
+C             pour les evolutions temporelles)
+C filenum: INTEGER
+C          nombre d'elements dans la liste files des champs desires
+C          si filenum = 0 alors tous les champs sont sortis  
+C files: CHARACTER*20 (100)
+C        list des champ que l'on desire sortire
+C
+C        PARAMETER
+C        +++++++++
+C bandmax: INTEGER
+C          le nombre maximale que peut traiter le programme
+C
+
+
+      IMPLICIT NONE
+
+      INTEGER bandmax
+      PARAMETER (bandmax = 24)
+      INTEGER icount,i,imin,imax
+      REAL champ(icount)
+      CHARACTER*100 titre, entete
+      CHARACTER unit*20,nom*80
+      CHARACTER*20 format
+      CHARACTER*8 date0, date
+      INTEGER deltpas(bandmax), nbeta(bandmax)
+      REAL deltajour(bandmax)
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      INTEGER filenum
+      CHARACTER*20 files(100)
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      check = .FALSE.
+
+      IF (filenum .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(nom,writeornot,filenum, files)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+      IF (writeornot) THEN
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) entete(1:lnblnk(entete))
+        WRITE(*,*) titre(1:lnblnk(titre))
+        WRITE(*,*) date0
+        WRITE(*,*) date
+        WRITE(*,*) unit(1:lnblnk(unit))
+        WRITE(*,*) deltpas, nbeta
+        WRITE(*,*) deltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) format(1:lnblnk(format))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) titre(1:lnblnk(titre)),'min,max:',
+     &           champ(imin),champ(imax),'  ',unit(1:lnblnk(unit))
+      
+      OPEN (unit=55, file=nom(1:lnblnk(nom)))
+      WRITE(55,'(a)') entete(1:lnblnk(entete))
+      WRITE(55,'(a)') titre(1:lnblnk(titre))
+      WRITE(55,'(a)') date0
+      WRITE(55,'(a)') date
+      WRITE(55,'(a)') unit(1:lnblnk(unit))
+      WRITE(55,*) deltpas, nbeta
+      WRITE(55,*) deltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//format(1:lnblnk(format))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//format(1:lnblnk(format))//')') champ(1)
+      ENDIF
+
+      IF (format(1:lnblnk(format)) .EQ. 'zxli1') THEN
+        CALL to36 (champ,icount,champ(imin),champ(imax),55, 1)
+      ELSE 
+        IF (format(1:lnblnk(format)) .EQ. 'zxli2') THEN
+          CALL to36 (champ, icount,champ(imin), champ(imax),55, 2)
+        ELSE
+          IF (format(1:lnblnk(format)) .EQ. 'zxli3') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55, 3)
+          ELSE
+            DO 2233 i=1,icount
+              WRITE(55,'('//format(1:lnblnk(format))//')') 
+     &             champ(i)
+ 2233       CONTINUE
+          ENDIF
+        ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      ELSE
+        WRITE(*,*) 'FILE    ',nom,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/LMDZ.MARS/libf/misc/readcoord.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/readcoord.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/readcoord.F	(revision 1403)
@@ -0,0 +1,123 @@
+      SUBROUTINE readcoord(imx,jmx,lmx,imax,jmax,lmax,x,y,z,pathcoor)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs Jan Polcher, Frederic Hourdin
+c   -------
+c
+c   Objet   Lecture du fichier contenant des coordonnees x,y et z.
+c   -----
+c
+c   Inteface
+c   --------
+c
+c   Arguments:
+c   ----------
+c
+c   input
+c   -----
+c      imx   \
+c      jmx          dimensions des coordonnees
+c      lmx   /
+c      pathcoor     path absolu pour le fichier des coordonnees
+c                   CHARACTER*80
+c
+c   ouput
+c   -----
+c      imax         nombre de coordonnees x effectives
+c      jmax         nombre de coordonnees y effectives
+c      lmax         nombre de coordonnees z effectives
+c      x(imx)
+c      y(jmx)
+c      z(lmx)
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+c   arguments:
+c   ----------
+
+      INTEGER imx,jmx,lmx
+      INTEGER imax,jmax,lmax
+
+      REAL x(imx),y(jmx),z(lmx)
+
+      CHARACTER*80 pathcoor
+
+c   local
+c   -----
+
+      INTEGER i,j,l
+
+      CHARACTER*100 filecoor,messerr
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      messerr=' '
+      filecoor='coord.def'
+
+c-----------------------------------------------------------------------
+
+100   IF(pathcoor(1:1).EQ.'/') THEN
+         filecoor= pathcoor(:lnblnk(pathcoor))//filecoor
+      ENDIF
+      OPEN (99,file=filecoor,err=200,status='old',form='formatted')
+      GO TO 300
+
+200   WRITE(*,*) messerr
+      WRITE(*,*) 'entrer le nom du fichier des coordonnees puis RETURN'
+      WRITE(*,*) 'ou seulement RETURN pour arreter le programme'
+      READ(*,'(a)') filecoor
+      IF(filecoor(1:1).EQ.' ') STOP
+      CLOSE (99)
+      GOTO 100
+
+300   CONTINUE
+
+      READ(99,*,err=9999) imax
+      IF(imax.GT.imx) THEN
+        WRITE(6,1000) 'x',imx,imax
+        STOP
+      ENDIF
+      READ(99,*) (x(i),i=1,imax)
+
+      READ(99,*,err=9999) jmax
+      IF(jmax.GT.jmx) THEN
+        WRITE(6,1000) 'y',jmx,jmax
+        STOP
+      ENDIF
+      READ(99,*,err=9999) (y(j),j=1,jmax)
+
+      READ(99,*,err=9999) lmax
+      IF(lmax.GT.lmx) THEN
+        WRITE(6,1000) 'z',lmx,lmax
+        STOP
+      ENDIF
+      READ(99,*) (z(l),l=1,lmax)
+
+      CLOSE(99)
+
+c-----------------------------------------------------------------------
+
+      RETURN
+
+9999  PRINT*,'Le fichier ',filecoor,' que vous lisez est mal structure'
+      PRINT*,'Il doit contenir :'
+      PRINT*,'  le nombre de points en x suivi des valeurs de x'
+      PRINT*,'  puis la meme chose pour y et z'
+      STOP
+
+1000  FORMAT(/,
+     $ 'Probleme avec le fichier de coordonnees',/,
+     $ 'Le tableau contenant ',a3,' est dimenssionne a ',i4,/,
+     $ 'et le fichier de coordonnees contient ',i4,' valeurs.')
+
+      END
Index: trunk/LMDZ.MARS/libf/misc/readstd.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/readstd.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/readstd.F	(revision 1403)
@@ -0,0 +1,286 @@
+      SUBROUTINE readstd(imx,champ,imax)
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin  20/04/91
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui lit les fichiers dans le format lmdstd
+c format etabli par :
+c  Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c imx  : INTEGER
+c        taille du tableau contenant le champ
+c champ: REAL (imx)
+c        champ contenant les valeurs et de longeur icount
+c imax : INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER imx,imax
+      REAL champ(imx)
+
+c   Local:
+c   ------
+
+      INTEGER i
+
+      CHARACTER*200 test(20)
+      CHARACTER*200 helptest(20)
+      CHARACTER*200 help
+      INTEGER reccount
+
+      LOGICAL check,continue
+
+      EXTERNAL lnblnk
+      INTEGER lnblnk
+
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+
+      check = .FALSE.
+      DO 9876 i=1,20
+        helptest(i) = '        '
+ 9876 CONTINUE
+
+
+c-----------------------------------------------------------------------
+c   lecture le l'entete:
+c   --------------------
+
+ 2222 OPEN (unit=10,file=gfichier(1:lnblnk(gfichier)), form='formatted',
+     &      ERR = 9999, status='old')
+      GOTO 1111
+
+ 9999 WRITE(*,*) 'Je ne peut pas lire le fichier: ',
+     & gfichier(1:lnblnk(gfichier))
+      CLOSE(10)
+      WRITE(*,*) 'Entrez S.V.P. un autre nom de fichier (path absolu) '
+      WRITE(*,*) 'ou RETURN pour stopper lexecution'
+      READ (*,'(a)') gfichier
+      IF(lnblnk(gfichier).EQ.0) STOP
+      GOTO 2222
+
+ 1111 continue = .TRUE.
+      DO 2345 i=1,20
+        IF (continue) THEN
+          READ (10,'(a200)') test(i)
+          IF ( test(i)(1:1) .EQ. '#' .OR. test(i)(1:1) .EQ. 'f10' ) THEN
+            continue = .FALSE.
+            reccount = i
+          ENDIF
+        ENDIF
+ 2345 CONTINUE
+
+      DO 1223 i=1,reccount-1
+        helptest(i) = test(i)
+ 1223 CONTINUE
+      helptest(20) = test(reccount)
+
+
+      IF (check) THEN
+        WRITE(*,*) 'gentete'
+      ENDIF
+      IF ( helptest(1) .NE. ' ' ) THEN
+        read (helptest(1),'(a100)') gentete
+      ELSE
+c       WRITE(*,*) 'la description du run'
+c       READ (*,'(a100)') gentete
+        gentete = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'titre'
+      ENDIF
+      IF ( helptest(2) .NE. ' ' ) THEN
+        read (helptest(2),'(a100)') gtitre
+      ELSE
+c       WRITE(*,*) 'le titre du dessin'
+c       READ (*,'(a100)') gtitre 
+        gtitre = '    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'datefins'
+      ENDIF
+      IF ( helptest(3) .NE. ' ' ) THEN
+        read (helptest(3),'(a8)') gdatedep 
+        read (helptest(4),'(a8)') gdatefin
+      ELSE
+c       WRITE(*,*)
+c    &  'datefin du debut de la moyenne (ou le mois tout simplement)'
+c       READ (*,'(a8)') gdatedep 
+c       WRITE(*,*) 'et celle de la fin (ou rien du tout)'
+c       READ (*,'(a8)') gdatefin 
+        gdatedep = '       '
+        gdatefin = '       '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'unitees'
+      ENDIF
+      IF ( helptest(5) .NE. ' ' ) THEN
+        read (helptest(5),'(a20)') gunites
+      ELSE
+c       WRITE(*,*) 'les unitees du champ'
+c       READ (*,'(a20)') gunites
+        gunites = '                    '
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltapas et nbetats'
+      ENDIF
+      IF ( helptest(6) .NE. ' ' ) THEN
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+        GOTO 1213
+
+ 1212   help =helptest(6)(1:lnblnk(helptest(6)))//
+     .        helptest(7)(1:lnblnk(helptest(7)))
+        helptest(6) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1214 i=7,reccount
+          helptest(i) = helptest(i+1)
+ 1214   CONTINUE
+c       READ (helptest(6),*,ERR=1212) 
+c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
+
+ 1213   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'deltajour'
+      ENDIF
+      IF ( helptest(7) .NE. ' ' ) THEN
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+        GOTO 1313
+
+ 1312   help =helptest(7)(1:lnblnk(helptest(7)))//
+     .        helptest(8)(1:lnblnk(helptest(8)))
+        helptest(7) = help
+        IF (check) THEN
+          WRITE(*,*) 'Problems while reading', help
+        ENDIF
+        DO  1314 i=8,reccount
+          helptest(i) = helptest(i+1)
+ 1314   CONTINUE
+c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
+
+ 1313   CONTINUE
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'min et max'
+      ENDIF
+      IF ( helptest(8) .NE. ' ' ) THEN
+c       READ (helptest(8),*)     gminimum,gmaximum
+      ENDIF
+
+      gformat = helptest(20)(2:20)
+
+      IF (check) THEN
+        WRITE(*,*) gentete
+        WRITE(*,*) gtitre
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin 
+        WRITE(*,*) gdeltapas,gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) gminimum,gmaximum
+        WRITE(*,*) gformat
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   lecture du champ proprement dit:
+c   --------------------------------
+
+      READ (10,*)     imax
+   
+      IF(imax.GT.imx) THEN
+         WRITE(*,*) 'Vous essayez de lire un champ dont la taille est'
+         WRITE(*,*) 'superieure a la taille maximum autorisee'
+         WRITE(*,*) 'c est a dire a la dimension du champ utilise'
+         WRITE(*,*) 'pour lappel a la procedure writestd.'
+         STOP
+      ENDIF
+
+      IF (gformat(1:4) .EQ. 'zxli') THEN
+        CALL from36 (champ,imax,10)
+      ELSE 
+         IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+            READ(10,*) (champ (i),i=1,imax)
+         ELSE
+            READ(10,'('//gformat(1:lnblnk(gformat))//')')
+     $      (champ (i),i=1,imax)
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=10)
+
+
+      RETURN
+      END
Index: trunk/LMDZ.MARS/libf/misc/scatter.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/scatter.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/scatter.F	(revision 1403)
@@ -0,0 +1,21 @@
+       subroutine scatter(n,a,index,b)
+C
+       implicit none
+       integer N,INDEX(n),I
+       real A(n),B(n)
+c
+c
+       DO 100 I=1,N
+          A(INDEX(I))=B(I)
+100    CONTINUE
+c
+       return
+       end 
+c
+c
+c      peut etre vec_scatter(v,rindices,count,r) en f77hp
+c      equivalent code:
+c      do 99 i=1,count
+c99    r(rindices(i))=v(i)
+c      voir p. 11-13
+c
Index: trunk/LMDZ.MARS/libf/misc/scopy.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/scopy.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/scopy.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopy(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      real sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+         sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/scopyi.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/scopyi.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/scopyi.F	(revision 1403)
@@ -0,0 +1,17 @@
+      subroutine scopyi(n,sx,incx,sy,incy)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,incy,ix,iy,i
+      integer sx((n-1)*incx+1),sy((n-1)*incy+1)
+c
+      iy=1
+      ix=1
+      do 10 i=1,n
+      sy(iy)=sx(ix)
+         ix=ix+incx
+         iy=iy+incy
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/sdot.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/sdot.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/sdot.F	(revision 1403)
@@ -0,0 +1,21 @@
+      FUNCTION sdot (n, x,incx, y,incy)
+      IMPLICIT NONE
+c
+      integer n, incx, incy
+      real sdot
+      real x((n-1)*incx+1), y((n-1)*incy+1)
+c
+      integer i, ix, iy
+c
+      sdot = 0.0
+      ix = 1
+      iy = 1
+c
+      do 10 i = 1, n
+         sdot = sdot + x(ix) * y(iy)
+         ix = ix + incx
+         iy = iy + incy
+   10 continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/ssum.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/ssum.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/ssum.F	(revision 1403)
@@ -0,0 +1,16 @@
+      function ssum(n,sx,incx)
+c
+      IMPLICIT NONE
+c
+      integer n,incx,i,ix
+      real ssum,sx((n-1)*incx+1)
+c
+      ssum=0.
+      ix=1
+      do 10 i=1,n
+      ssum=ssum+sx(ix)
+         ix=ix+incx
+10    continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/to36.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/to36.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/to36.F	(revision 1403)
@@ -0,0 +1,84 @@
+      SUBROUTINE to36(x,nbre,xmin,xmax,iunit,icase)
+Ccray IMPLICIT NONE
+      IMPLICIT NONE
+c=======================================================================
+c-- x    : le champ a compacter
+c-- nbre : la taille du champ x
+c-- iunit: numero logique du fichier sortie
+c-- icase: nombre de cases a utiliser (qui determine la precision)
+      INTEGER iunit, nbre, icase
+      REAL x(nbre) 
+c=======================================================================
+      INTEGER ibase, maxnbr, ifact1, ifact2, ifact3
+      PARAMETER (ibase=36, maxnbr=100000)
+      PARAMETER (ifact1 = ibase**1-1)
+      PARAMETER (ifact2 = ibase**2-1)
+      PARAMETER (ifact3 = ibase**3-1)
+c=======================================================================
+      CHARACTER*1 word1(0:ifact1)
+      COMMON /elbat1/ word1
+      CHARACTER*1 chax1(maxnbr)
+c======================================================================
+      CHARACTER*2 word2(0:ifact2)
+      COMMON /elbat2/ word2
+      CHARACTER*2 chax2(maxnbr)
+c======================================================================
+      CHARACTER*3 word3(0:ifact3)
+      COMMON /elbat3/ word3
+      CHARACTER*3 chax3(maxnbr)
+c=====================================================================
+      INTEGER i, inte
+      REAL xmin, xmax
+      EXTERNAL ini36
+c=====================================================================
+c
+c--- initialisation pour le codage
+c la routine ini36 est appelee une seule fois
+c     IF (word1(36) .NE. 'Z' ) THEN
+        CALL ini36
+c     ENDIF
+
+      IF (nbre .GT. maxnbr) THEN
+        PRINT*, 'Nombre elements trop grand', nbre, maxnbr
+        STOP
+      ENDIF
+c
+      WRITE(iunit,*) nbre, ibase, icase, '  (nbre,ibase,icase)'
+      WRITE(iunit,*) xmin
+      WRITE(iunit,*) xmax
+c
+      IF(xmin .EQ. xmax)THEN
+      WRITE(iunit,'(a)')'Ce champ est constant'
+      GO TO 999
+      ENDIF 
+c
+      IF (icase .EQ. 1) THEN
+        DO 10 i = 1, nbre
+          inte = NINT( FLOAT(ifact1)/(xmax-xmin) * (x(i)-xmin) )
+          chax1(i) = word1(inte)
+   10   CONTINUE
+        WRITE(iunit,91) (chax1(i),i=1,nbre)
+      ELSE IF (icase .EQ. 2) THEN
+        DO 20 i = 1, nbre
+          inte = NINT( FLOAT(ifact2)/(xmax-xmin) * (x(i)-xmin) )
+          chax2(i) = word2(inte)
+   20   CONTINUE
+        WRITE(iunit,92) (chax2(i),i=1,nbre)
+      ELSE IF (icase.eq.3) THEN
+        DO 30 i = 1, nbre
+          inte = NINT( FLOAT(ifact3)/(xmax-xmin) * (x(i)-xmin) )
+          chax3(i) = word3(inte)
+   30   CONTINUE
+        WRITE(iunit,93) (chax3(i),i=1,nbre)
+      ELSE
+        PRINT*, 'Verfier icase (1,2,3) dans les arguments de to36'
+        STOP
+      ENDIF
+c
+   91 FORMAT(120a1)
+   92 FORMAT(64a2)
+   93 FORMAT(40a3)
+c
+  999 RETURN
+      END 
+
Index: trunk/LMDZ.MARS/libf/misc/wheneq.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/wheneq.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/wheneq.F	(revision 1403)
@@ -0,0 +1,23 @@
+      SUBROUTINE wheneq(n,x,incx,target,index,nn)
+      IMPLICIT NONE
+c
+      integer n, incx, nn
+      integer index(n)
+c
+      integer target, x((n-1)*incx+1)
+cccccc      real target, x((n-1)*incx+1)
+c
+      integer i, ix
+c
+      ix = 1
+      nn = 0
+      do 10 i = 1, n
+         if (x(ix).EQ.target) then
+            index(i) = ix
+            nn = nn + 1
+         endif
+         ix = ix + incx
+   10 continue
+c
+      return
+      end
Index: trunk/LMDZ.MARS/libf/misc/writestd.F
===================================================================
--- trunk/LMDZ.MARS/libf/misc/writestd.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/misc/writestd.F	(revision 1403)
@@ -0,0 +1,200 @@
+      SUBROUTINE writestd(champ,icount)
+
+c=======================================================================
+c
+c   Auteurs:   Jan Polcher, Frederic Hourdin
+c   --------
+c
+c   Objet:
+c   ------
+c
+c Subroutine qui ecrit les fichiers dans le format de transfert
+c vers le LMD.
+c format etabli par :
+c   Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
+c   Jan Polcher .
+c Il peut etre utilise pour sortire  des evolutions
+c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
+c le character # place devant le format determine la fin de la 
+c description du champ et permet eventulellement de rajouter
+c des informations (avant le #).
+c le programme de lecture lit , dans la description, les variables
+c qu'il connait et saute apres jusquau #. A partir de la
+c il commence a lire le champ dans le format specifie.
+c
+c-----------------------------------------------------------------------
+c
+c   Interface:
+c   ----------
+c
+c   ARGUMENTS
+c   ---------
+c
+c champ: REAL (icount)
+c        champ contenant les valeurs et de longeur icount
+c icount: INTEGER
+c        nombre d'element dans le champ
+c
+c   COMMON:
+c   -------
+c
+c=======================================================================
+c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
+c
+c     INTEGER bandmax
+c     PARAMETER(bandmax=24)
+c
+c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
+c    $                gentete,gdatedep,gdatefin
+c       
+c     CHARACTER*100 gtitre    !du champ
+c     CHARACTER*20  gunites   !unites du champ
+c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
+c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
+c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
+c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
+c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
+c     CHARACTER*20  glistfich !liste de champs a sortir
+c
+c     COMMON/lmdstdnu/ gminimum,gmaximum,
+c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
+c    $                 gnbetats(bandmax),gnbfich
+c
+c     REAL    gminimum        ! \    min et max
+c     REAL    gmaximum        ! /    du champ
+c     INTEGER gnbfich         ! nombre de fichier a sortir
+c pour les evolutions temporelles:
+c     INTEGER gnbetats        ! nombre d'etats par bande
+c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
+c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+      IMPLICIT NONE
+#include "lmdstd.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER icount
+      REAL champ(icount)
+
+c   Local:
+c   ------
+
+      INTEGER i,imin,imax
+      LOGICAL check, writeornot
+      INTEGER lnblnk,ismin,ismax
+      EXTERNAL lnblnk,ismin,ismax, isitor, to36
+
+      INTEGER indexfil
+      COMMON/indexfil/indexfil
+
+c-----------------------------------------------------------------------
+c   verification que le champ est dans la liste predefinie:
+c   -------------------------------------------------------
+
+      check = .FALSE.
+
+      IF (gnbfich .EQ. 0) THEN
+        writeornot = .TRUE.
+      ELSE
+        CALL isitor(gfichier,writeornot,gnbfich, glistfich)
+      ENDIF
+
+      IF (check) THEN
+        WRITE(*,*) 'MYWRITE:: writeornot=',writeornot
+      ENDIF
+
+c-----------------------------------------------------------------------
+      IF (writeornot) THEN
+c-----------------------------------------------------------------------
+
+      imin = ismin(icount,champ,1)
+      imax = ismax(icount,champ,1)
+      IF (check) THEN
+        WRITE(*,*) gentete(1:lnblnk(gentete))
+        WRITE(*,*) gtitre(1:lnblnk(gtitre))
+        WRITE(*,*) gdatedep
+        WRITE(*,*) gdatefin
+        WRITE(*,*) gunites(1:lnblnk(gunites))
+        WRITE(*,*) gdeltapas, gnbetats
+        WRITE(*,*) gdeltajour
+        WRITE(*,*) champ(imin),champ(imax)
+        WRITE(*,*) gformat(1:lnblnk(gformat))
+        WRITE(*,*) icount
+      ENDIF
+      WRITE(*,*) gtitre(1:lnblnk(gtitre)),'min,max:',
+     &  champ(imin),champ(imax),'  ',gunites(1:lnblnk(gunites))
+      
+c-----------------------------------------------------------------------
+c   creation eventuelle d'un nom pour le fichier d'ecriture du champ:
+c   -----------------------------------------------------------------
+
+      IF(lnblnk(gfichier).LT.1.OR.lnblnk(gfichier).GE.100) THEN
+         gfichier(1:5)='champ'
+         IF(indexfil.LT.1) indexfil=49
+         gfichier(6:6)=char(indexfil)
+	 indexfil=indexfil+1
+	 PRINT*,'nom du fichier  ',gfichier
+      ENDIF
+
+c-----------------------------------------------------------------------
+c   ecriture sur le fichier de sorties:
+c   -----------------------------------
+
+      OPEN (unit=55, file=gfichier(1:lnblnk(gfichier)))
+      WRITE(55,'(a)') gentete(1:lnblnk(gentete))
+      WRITE(55,'(a)') gtitre(1:lnblnk(gtitre))
+      WRITE(55,'(a)') gdatedep
+      WRITE(55,'(a)') gdatefin
+      WRITE(55,'(a)') gunites(1:lnblnk(gunites))
+      WRITE(55,*) gdeltapas, gnbetats
+      WRITE(55,*) gdeltajour
+      WRITE(55,*) champ(imin),champ(imax)
+      WRITE(55,'(a)') '#'//gformat(1:lnblnk(gformat))
+      WRITE(55,*) icount
+
+      IF (check) THEN
+        WRITE(*,'('//gformat(1:lnblnk(gformat))//')') champ(1)
+      ENDIF
+
+      IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
+         DO 2230 i=1,icount
+            WRITE(55,*) champ(i)
+2230     CONTINUE
+      ELSE
+         IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli1') THEN
+            CALL to36 (champ,icount,champ(imin),champ(imax),55,1)
+         ELSE 
+            IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli2') THEN
+            CALL to36(champ,icount,champ(imin),champ(imax),55,2)
+            ELSE
+               IF (gformat(1:lnblnk(gformat)) .EQ. 'zxli3') THEN
+            CALL to36(champ,icount,champ(imin),champ(imax),55,3)
+               ELSE
+                  WRITE(55,'('//gformat(1:lnblnk(gformat))//')') 
+     &            (champ(i),i=1,icount)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CLOSE (unit=55)
+
+      gfichier=' '
+
+c-----------------------------------------------------------------------
+c   si on ecrit pas le champ (writeornot.EQ..f.):
+c   ---------------------------------------------
+
+      ELSE
+        WRITE(*,*) 'FILE    ',gfichier,'WAS NOT WRITEN'
+      ENDIF
+      
+      RETURN
+      END
+
Index: trunk/LMDZ.MARS/libf/phymars/datareadnc.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/datareadnc.F	(revision 1399)
+++ 	(revision )
@@ -1,311 +1,0 @@
-c=======================================================================
-      SUBROUTINE datareadnc(relief,phisinit,alb,ith,z0,
-     &                    zmea,zstd,zsig,zgam,zthe)
-c=======================================================================
-c
-c
-c   Author: F. Hourdin      01/1997
-c   -------
-c
-c   Object: To read data from Martian surface to use in a GCM
-c   ------                from NetCDF file "surface.nc"
-c
-c
-c   Arguments:
-c   ----------
-c
-c     Inputs:
-c     ------
-c
-c     Outputs:
-c     --------
-c
-c=======================================================================
-c   donnees ALBEDO, INERTIE THERMIQUE, RELIEF:
-c
-c       Ces donnees sont au format NetCDF dans le fichier "surface.nc"
-c
-c   360 valeurs en longitude (de -179.5 a 179.5)
-c   180 valeurs en latitudes (de 89.5 a -89.5)
-c
-c   Pour les passer au format de la grille, on utilise "interp_horiz.F"
-c
-c   Il faut donc que ces donnees soient au format grille scalaire
-c               (imold+1 jmold+1)
-c       avec passage des coordonnees de la "boite" (rlonu, rlatv)
-c
-c   On prend imd (d pour donnees!) 
-c           imd = 360 avec copie de la 1ere valeur sur la imd+1 
-c                   (rlonud de -179 a -181)
-c           jmd = 179 
-c                   (rlatvd de 89 a -89)
-c=======================================================================
-
-! to use  'getin'
-       use ioipsl_getincom 
-
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comconst.h"
-#include "netcdf.inc"
-#include "datafile.h"
-
-c=======================================================================
-c   Declarations:
-C=======================================================================
-
-      INTEGER    imd,jmd,imdp1,jmdp1
-      parameter    (imd=360,jmd=179,imdp1=361,jmdp1=180)
-
-      INTEGER    iimp1
-      parameter    (iimp1=iim+1-1/iim)
-
-! Arguments:
-      CHARACTER(len=3),intent(inout) :: relief
-      REAL,intent(out) :: phisinit(iimp1*jjp1)
-      REAL,intent(out) :: alb(iimp1*jjp1)
-      REAL,intent(out) :: ith(iimp1*jjp1)
-      REAL,intent(out) :: z0(iimp1*jjp1)
-      REAL,intent(out) :: zmea(imdp1*jmdp1)
-      REAL,intent(out) :: zstd(imdp1*jmdp1)
-      REAL,intent(out) :: zsig(imdp1*jmdp1)
-      REAL,intent(out) :: zgam(imdp1*jmdp1)
-      REAL,intent(out) :: zthe(imdp1*jmdp1)
-
-! Local variables:
-      REAL        zdata(imd*jmdp1)
-      REAL        zdataS(imdp1*jmdp1)
-      REAL        pfield(iimp1*jjp1)
-
-      INTEGER     ierr
-
-      INTEGER   unit,nvarid
-
-      INTEGER    i,j,k
-
-      INTEGER klatdat,ngridmxgdat
-      PARAMETER (klatdat=180,ngridmxgdat=360)
-
-c    on passe une grille en rlonu rlatv et im+1 jm a interp_horiz)
-
-      REAL longitude(imd),latitude(jmdp1) ! Pour lecture des donnees
-      REAL rlonud(imdp1),rlatvd(jmd)
-
-      CHARACTER*20 string
-      DIMENSION string(0:4)
-
-
-!#include "lmdstd.h"
-#include "fxyprim.h"
-
-      pi=2.*ASIN(1.)
-
-c=======================================================================
-c    rlonud, rlatvd
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF des donnees latitude et longitude
-c-----------------------------------------------------------------------
-      write(*,*) 'datareadnc: opening file surface.nc'
-
-      datafile="/u/lmdz/WWW/planets/mars/datadir" ! default path to surface.nc
-      call getin("datadir",datafile) ! but users may specify another path
-      
-      ierr = NF_OPEN (trim(datafile)//'/surface.nc',
-     &  NF_NOWRITE,unit)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(*,*)'Error : cannot open file surface.nc '
-        write(*,*)'(in phymars/datareadnc.F)'
-        write(*,*)'It should be in :',trim(datafile),'/'
-        write(*,*)'1) You can set this path in the 
-     & callphys.def file:'
-        write(*,*)'   datadir=/path/to/the/datafiles'
-        write(*,*)'2) If necessary, surface.nc (and other datafiles)'
-        write(*,*)'   can be obtained online on:'
-        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
-        CALL ABORT
-      ENDIF
-
-c
-c Lecture des latitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "latitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, latitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, latitude)
-#endif
-c
-c Lecture des longitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (unit, "longitude", nvarid)
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, longitude)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, longitude)
-#endif
-
-c-----------------------------------------------------------------------
-c    Passage au format boites scalaires
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c       longitude(imd)        -->      rlonud(imdp1) 
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do i=1,imd 
-          rlonud(i)=(longitude(i)+.5)*pi/180.
-      enddo
-
-c Repetition de la valeur im+1
-      rlonud(imdp1)=rlonud(1) + 2*pi
-
-c-----------------------------------------------------------------------
-c        latitude(jmdp1)         -->        rlonvd(jmd)
-c-----------------------------------------------------------------------
-
-c Passage en coordonnees boites scalaires et en radian
-      do j=1,jmd 
-          rlatvd(j)=(latitude(j)-.5)*pi/180.
-      enddo
-
-c=======================================================================
-c   lecture NetCDF de albedo, thermal, relief, zdtm (pour francois Lott)
-c=======================================================================
-
-      string(0) = 'z0'
-      string(1) = 'albedo'
-      string(2) = 'thermal'
-      if (relief.ne.'pla') then
-        write(*,*) ' MOLA topography'
-        relief = 'MOL'
-          string(3) = 'z'//relief
-      else
-          string(3) = 'zMOL'  ! pour qu''il lise qqchose sur le fichier
-                            ! remise a 0 derriere
-      endif
-      string(4) = 'zMOL'    ! lecture pour calcul topog. sous-maille
- 
-
-      DO k=0,4
-          write(*,*) 'string',k,string(k)
-          
-c-----------------------------------------------------------------------
-c    initialisation
-c-----------------------------------------------------------------------
-      call initial0(iimp1*jjp1,pfield)
-      call initial0(imd*jmdp1,zdata)
-      call initial0(imdp1*jmdp1,zdataS)
-
-c-----------------------------------------------------------------------
-c    Lecture NetCDF  
-c-----------------------------------------------------------------------
-
-      ierr = NF_INQ_VARID (unit, string(k), nvarid)
-      if (ierr.ne.nf_noerr) then
-        write(*,*) 'datareadnc error, cannot find ',trim(string(k))
-        write(*,*) ' in file ',trim(datafile),'/surface.nc'
-        stop
-      endif
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(unit, nvarid, zdata)
-#else
-      ierr = NF_GET_VAR_REAL(unit, nvarid, zdata)
-#endif
-      if (ierr.ne.nf_noerr) then
-        write(*,*) 'datareadnc: error failed loading ',trim(string(k))
-        stop
-      endif
-
-c-----------------------------------------------------------------------
-c        Cas particulier "Francois Lott" ( k=4 ) (relief sous-maille)
-c-----------------------------------------------------------------------
-      if (k.eq.4) then
-
-          call multscal(imd*jmdp1,zdata,1000.,zdata)
-          call multscal(imd,longitude,pi/180.,longitude)
-          call multscal(jmdp1,latitude,pi/180.,latitude)
-
-          call grid_noro1(360, 180, longitude, latitude, zdata,
-     .         iim, jjp1, rlonv, rlatu, zmea,zstd,zsig,zgam,zthe)
-
-          CALL dump2d(iip1,jjp1,zmea,'zmea')
-          CALL dump2d(iip1,jjp1,zstd,'zstd')
-          CALL dump2d(iip1,jjp1,zsig,'zsig')
-          CALL dump2d(iip1,jjp1,zgam,'zgam')
-          CALL dump2d(iip1,jjp1,zthe,'zthe')
-
-      endif
-
-c-----------------------------------------------------------------------
-c   Passage de zdata en grille (imdp1 jmdp1)
-c-----------------------------------------------------------------------
-      do j=1,jmdp1
-          do i=1,imd
-              zdataS(i+imdp1*(j-1)) = zdata(i+ngridmxgdat*(j-1))
-          enddo
-          zdataS(imdp1+imdp1*(j-1)) = zdata(1+ngridmxgdat*(j-1))
-      enddo
-
-c-----------------------------------------------------------------------
-c    Interpolation
-c-----------------------------------------------------------------------
-      call interp_horiz(zdataS,pfield,imd,jmd,
-     .    iim, jjm,1,rlonud,rlatvd,rlonu,rlatv) 
-
-c-----------------------------------------------------------------------
-c    Periodicite    
-c-----------------------------------------------------------------------
-
-      do j=1,jjp1
-         pfield(iimp1*j) =  pfield(1+iimp1*(j-1))
-      enddo 
- 
-c-----------------------------------------------------------------------
-c    Sauvegarde des champs    
-c-----------------------------------------------------------------------
-
-      if (k.eq.0) then                    ! z0
-         z0(1:iimp1*jjp1)=pfield(1:iimp1*jjp1)*.01
-         ! multiplied by 0.01 to have z0 in m
-         CALL dump2d(iimp1,jjp1,z0,'z0 in m')
-      elseif (k.eq.1) then                    ! albedo
-         do i=1,iimp1*jjp1
-              alb(i) = pfield(i)
-          enddo
-      elseif (k.eq.2) then                ! thermal
-         do i=1,iimp1*jjp1
-              ith(i) = pfield(i)
-          enddo
-      elseif (k.eq.3) then                ! relief
-        if (relief.eq.'pla') then
-              call initial0(iimp1*jjp1,phisinit)
-        else
-             do i=1,iimp1*jjp1
-                  phisinit(i) = pfield(i)
-              enddo
-        endif
-      endif
-
-      ENDDO
-
-c-----------------------------------------------------------------------
-c    Traitement Phisinit
-c-----------------------------------------------------------------------
-
-      DO i=1,iimp1*jjp1
-            phisinit(i)=1000.*phisinit(i)
-      ENDDO
-      CALL dump2d(iimp1,jjp1,phisinit,'Altitude in m')
-      CALL multscal(iimp1*jjp1,phisinit,g,phisinit)
-
-c-----------------------------------------------------------------------
-c    FIN
-c-----------------------------------------------------------------------
-
-      END
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/comconst.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comconst.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/comgeom.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comgeom.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/comvert.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/comvert.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/control_mod.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/control_mod.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/description.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/description.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/ener.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/ener.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/infotrac.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/infotrac.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/logic.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/logic.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_const_mpi.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/mod_const_mpi.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_grid_phy_lmdz.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_grid_phy_lmdz.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_data.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_mpi_transfert.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_data.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_omp_transfert.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_para.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dynlonlat_phylonlat/mod_phys_lmdz_transfert_para.F90
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/paramet.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/paramet.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/serre.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/serre.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/temps.h	(revision 1403)
@@ -0,0 +1,1 @@
+link ../../dyn3d/temps.h
Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1403)
+++ trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F	(revision 1403)
@@ -0,0 +1,830 @@
+
+      PROGRAM testphys1d
+! to use  'getin'
+      USE ioipsl_getincom, only: getin
+      use infotrac, only: nqtot, tname
+      use comsoil_h, only: volcapa, layer, mlayer, inertiedat, nsoilmx
+      use comgeomfi_h, only: lati, long, area, sinlat, ini_fillgeom
+      use surfdat_h, only: albedodat, z0_default, emissiv, emisice,
+     &                     albedice, iceradius, dtemisice, z0,
+     &                     zmea, zstd, zsig, zgam, zthe, phisfi,
+     &                     watercaptag
+      use slope_mod, only: theta_sl, psi_sl
+      use control_mod, only: day_step
+      use phyredem, only: physdem0,physdem1
+      use comgeomphy, only: initcomgeomphy
+      use planete_h, only: year_day, periheli, aphelie, peri_day,
+     &                     obliquit, emin_turb, lmixmin
+      use comcstfi_h, only: pi, rad, daysec, omeg, g, mugaz, rcp, r,
+     &                      cpp, dtphys
+      use dimradmars_mod, only: tauscaling,tauvis
+      IMPLICIT NONE
+
+c=======================================================================
+c   subject:
+c   --------
+c   PROGRAM useful to run physical part of the martian GCM in a 1D column
+c       
+c Can be compiled with a command like (e.g. for 25 layers)
+c  "makegcm -p mars -d 25 testphys1d"
+c It requires the files "testphys1d.def" "callphys.def"
+c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
+c      and a file describing the sigma layers (e.g. "z2sig.def")
+c
+c   author: Frederic Hourdin, R.Fournier,F.Forget
+c   -------
+c   
+c   update: 12/06/2003 including chemistry (S. Lebonnois) 
+c                            and water ice (F. Montmessin)
+c 
+c=======================================================================
+
+#include "dimensions.h"
+      integer, parameter :: ngrid = 1 !(2+(jjm-1)*iim - 1/jjm)
+      integer, parameter :: nlayer = llm
+!#include "dimradmars.h"
+!#include "comgeomfi.h"
+!#include "surfdat.h"
+!#include "slope.h"
+!#include "comsoil.h"
+!#include "comdiurn.h"
+#include "callkeys.h"
+!#include "comsaison.h"
+!#include "control.h"
+#include "comvert.h"
+#include "netcdf.inc"
+#include "comg1d.h"
+#include "logic.h"
+!#include "advtrac.h"
+
+c --------------------------------------------------------------
+c  Declarations
+c --------------------------------------------------------------
+c
+      INTEGER unitstart      ! unite d'ecriture de "startfi"
+      INTEGER nlevel,nsoil,ndt
+      INTEGER ilayer,ilevel,isoil,idt,iq
+      LOGICAl firstcall,lastcall
+c
+      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
+c
+      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
+      REAL day           ! date durant le run
+      REAL time             ! time (0<time<1 ; time=0.5 a midi)
+      REAL play(nlayer)   ! Pressure at the middle of the layers (Pa)
+      REAL plev(nlayer+1) ! intermediate pressure levels (pa)
+      REAL psurf,tsurf(1)      
+      REAL u(nlayer),v(nlayer)  ! zonal, meridional wind
+      REAL gru,grv   ! prescribed "geostrophic" background wind
+      REAL temp(nlayer)   ! temperature at the middle of the layers
+      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
+      REAL,ALLOCATABLE :: qsurf(:) ! tracer surface budget (e.g. kg.m-2)
+      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
+      REAL co2ice(1)        ! co2ice layer (kg.m-2)
+      REAL emis(1)          ! surface layer
+      REAL q2(nlayer+1)   ! Turbulent Kinetic Energy
+      REAL zlay(nlayer)   ! altitude estimee dans les couches (km)
+
+c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
+      REAL du(nlayer),dv(nlayer),dtemp(nlayer)
+      REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer)
+      REAL dpsurf    
+      REAL,ALLOCATABLE :: dq(:,:)
+      REAL,ALLOCATABLE :: dqdyn(:,:)
+
+c   Various intermediate variables
+      INTEGER thermo
+      REAL zls
+      REAL phi(nlayer),h(nlayer),s(nlayer)
+      REAL pks, ptif, w(nlayer)
+      REAL qtotinit,qtot
+      real,allocatable :: mqtot(:)
+      INTEGER ierr, aslun
+      REAL tmp1(0:nlayer),tmp2(0:nlayer)
+      Logical  tracerdyn
+      integer :: nq=1 ! number of tracers
+      real :: latitude(1), longitude(1)
+
+      character*2 str2
+      character (len=7) :: str7
+      character(len=44) :: txt
+
+c=======================================================================
+
+c=======================================================================
+c INITIALISATION
+c=======================================================================
+! initialize "serial/parallel" related stuff
+!      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+      call initcomgeomphy
+
+c ------------------------------------------------------
+c  Prescribed constants to be set here
+c ------------------------------------------------------
+
+      pi=2.E+0*asin(1.E+0)
+
+c     Mars planetary constants
+c     ----------------------------
+      rad=3397200.               ! mars radius (m)  ~3397200 m
+      daysec=88775.              ! length of a sol (s)  ~88775 s
+      omeg=4.*asin(1.)/(daysec)  ! rotation rate (rad.s-1)
+      g=3.72                     ! gravity (m.s-2) ~3.72  
+      mugaz=43.49                ! atmosphere mola mass (g.mol-1) ~43.49
+      rcp=.256793                ! = r/cp  ~0.256793
+      r= 8.314511E+0 *1000.E+0/mugaz
+      cpp= r/rcp
+      year_day = 669             ! lenght of year (sols) ~668.6
+      periheli = 206.66          ! minimum sun-mars distance (Mkm) ~206.66
+      aphelie = 249.22           ! maximum sun-mars distance (Mkm) ~249.22
+      peri_day =  485.           ! perihelion date (sols since N. Spring)
+      obliquit = 25.2            ! Obliquity (deg) ~25.2         
+ 
+c     Planetary Boundary Layer and Turbulence parameters 
+c     --------------------------------------------------
+      z0_default =  1.e-2        ! surface roughness (m) ~0.01 
+      emin_turb = 1.e-6          ! minimal turbulent energy ~1.e-8
+      lmixmin = 30               ! mixing length ~100
+ 
+c     cap properties and surface emissivities
+c     ----------------------------------------------------
+      emissiv= 0.95              ! Bare ground emissivity ~.95
+      emisice(1)=0.95            ! Northern cap emissivity
+      emisice(2)=0.95            ! Southern cap emisssivity
+      albedice(1)=0.5            ! Northern cap albedo
+      albedice(2)=0.5            ! Southern cap albedo
+      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
+      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
+      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
+      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
+
+
+c ------------------------------------------------------
+c  Loading run parameters from "run.def" file
+c ------------------------------------------------------
+
+
+! check if 'run.def' file is around (otherwise reading parameters
+! from callphys.def via getin() routine won't work.
+      open(99,file='run.def',status='old',form='formatted',
+     &     iostat=ierr)
+      if (ierr.ne.0) then
+        write(*,*) 'Cannot find required file "run.def"'
+        write(*,*) '  (which should contain some input parameters'
+        write(*,*) '   along with the following line:'
+        write(*,*) '   INCLUDEDEF=callphys.def'
+        write(*,*) '   )'
+        write(*,*) ' ... might as well stop here ...'
+        stop
+      else
+        close(99)
+      endif
+
+! check if we are going to run with or without tracers
+      write(*,*) "Run with or without tracer transport ?"
+      tracer=.false. ! default value
+      call getin("tracer",tracer)
+      write(*,*) " tracer = ",tracer
+
+! while we're at it, check if there is a 'traceur.def' file
+! and process it.
+      if (tracer) then
+      ! load tracer names from file 'traceur.def'
+        open(90,file='traceur.def',status='old',form='formatted',
+     &       iostat=ierr)
+        if (ierr.ne.0) then
+          write(*,*) 'Cannot find required file "traceur.def"'
+          write(*,*) ' If you want to run with tracers, I need it'
+          write(*,*) ' ... might as well stop here ...'
+          stop
+        else
+          write(*,*) "testphys1d: Reading file traceur.def"
+          ! read number of tracers:
+          read(90,*,iostat=ierr) nq
+          nqtot=nq ! set value of nqtot (in infotrac module) as nq
+          if (ierr.ne.0) then
+            write(*,*) "testphys1d: error reading number of tracers"
+            write(*,*) "   (first line of traceur.def) "
+            stop
+          endif
+        endif
+        ! allocate arrays:
+        allocate(tname(nq))
+        allocate(q(nlayer,nq))
+        allocate(qsurf(nq))
+        allocate(dq(nlayer,nq))
+        allocate(dqdyn(nlayer,nq))
+        allocate(mqtot(nq))
+        
+        ! read tracer names from file traceur.def
+        do iq=1,nq
+          read(90,*,iostat=ierr) tname(iq)
+          if (ierr.ne.0) then
+            write(*,*) 'testphys1d: error reading tracer names...'
+            stop
+          endif
+        enddo
+        close(90)
+
+        ! initialize tracers here:
+        write(*,*) "testphys1d: initializing tracers"
+        q(:,:)=0 ! default, set everything to zero
+        qsurf(:)=0
+        ! "smarter" initialization of some tracers
+        ! (get values from "profile_*" files, if these are available)
+        do iq=1,nq
+          txt=""
+          write(txt,"(a)") tname(iq)
+          write(*,*)"  tracer:",trim(txt)
+          ! CO2
+          if (txt.eq."co2") then
+            q(:,iq)=0.95   ! kg /kg of atmosphere
+            qsurf(iq)=0. ! kg/m2 (not used for CO2)
+            ! even better, look for a "profile_co2" input file
+            open(91,file='profile_co2',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            endif
+            close(91)
+          endif ! of if (txt.eq."co2")
+          ! Allow for an initial profile of argon
+          ! Can also be used to introduce a decaying tracer
+          ! in the 1D (TBD) to study thermals
+          if (txt.eq."ar") then
+            !look for a "profile_ar" input file
+            open(91,file='profile_ar',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ar file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ar")
+
+          ! WATER VAPOUR
+          if (txt.eq."h2o_vap") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_vap',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_vap file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! WATER ICE
+          if (txt.eq."h2o_ice") then
+            !look for a "profile_h2o_vap" input file
+            open(91,file='profile_h2o_ice',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_h2o_ice file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."h2o_ice")
+          ! DUST
+          !if (txt(1:4).eq."dust") then
+          !  q(:,iq)=0.4    ! kg/kg of atmosphere
+          !  qsurf(iq)=100 ! kg/m2
+          !endif
+          ! DUST MMR
+          if (txt.eq."dust_mass") then
+            !look for a "profile_dust_mass" input file
+            open(91,file='profile_dust_mass',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_mass file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_mass")
+          ! DUST NUMBER
+          if (txt.eq."dust_number") then
+            !look for a "profile_dust_number" input file
+            open(91,file='profile_dust_number',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_dust_number file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."dust_number")
+          ! NB: some more initializations (chemistry) is done later
+          ! CCN MASS
+          if (txt.eq."ccn_mass") then
+            !look for a "profile_ccn_mass" input file
+            open(91,file='profile_ccn_mass',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ccn_mass file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ccn_mass")
+          ! CCN NUMBER
+          if (txt.eq."ccn_number") then
+            !look for a "profile_ccn_number" input file
+            open(91,file='profile_ccn_number',status='old',
+     &       form='formatted',iostat=ierr)
+            if (ierr.eq.0) then
+              read(91,*) qsurf(iq)
+              do ilayer=1,nlayer
+                read(91,*) q(ilayer,iq)
+              enddo
+            else
+              write(*,*) "No profile_ccn_number file!"
+            endif
+            close(91)
+          endif ! of if (txt.eq."ccn_number")
+        enddo ! of do iq=1,nq
+
+      else
+      ! we still need to set (dummy) tracer number and names for physdem1
+        nq=1
+        nqtot=nq ! set value of nqtot (in infotrac module) as nq
+        ! allocate arrays:
+        allocate(tname(nq))
+        allocate(q(nlayer,nq))
+        allocate(qsurf(nq))
+        allocate(dq(nlayer,nq))
+        allocate(dqdyn(nlayer,nq))
+        allocate(mqtot(nq))
+        do iq=1,nq
+          write(str7,'(a1,i2.2)')'t',iq
+          tname(iq)=str7
+        enddo
+      ! and just to be clean, also initialize tracers to zero for physdem1
+        q(:,:)=0 
+        qsurf(:)=0      
+      endif ! of if (tracer)
+      
+      !write(*,*) "testphys1d q", q(1,:)
+      !write(*,*) "testphys1d qsurf", qsurf
+
+c  Date and local time at beginning of run
+c  ---------------------------------------
+c    Date (in sols since spring solstice) at beginning of run
+      day0 = 0 ! default value for day0
+      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
+      call getin("day0",day0)
+      day=float(day0)
+      write(*,*) " day0 = ",day0
+c  Local time at beginning of run 
+      time=0 ! default value for time
+      write(*,*)'Initial local time (in hours, between 0 and 24)?'
+      call getin("time",time)
+      write(*,*)" time = ",time
+      time=time/24.E+0 ! convert time (hours) to fraction of sol
+
+c  Discretization (Definition of grid and time steps)
+c  --------------
+c
+      nlevel=nlayer+1
+      nsoil=nsoilmx
+
+      day_step=48 ! default value for day_step
+      PRINT *,'Number of time steps per sol ?'
+      call getin("day_step",day_step)
+      write(*,*) " day_step = ",day_step
+
+      ndt=10 ! default value for ndt
+      PRINT *,'Number of sols to run ?'
+      call getin("ndt",ndt)
+      write(*,*) " ndt = ",ndt
+
+      ndt=ndt*day_step     
+      dtphys=daysec/day_step  
+
+c Imposed surface pressure
+c ------------------------------------
+c
+      psurf=610. ! default value for psurf
+      PRINT *,'Surface pressure (Pa) ?'
+      call getin("psurf",psurf)
+      write(*,*) " psurf = ",psurf
+c Reference pressures
+      pa=20.   ! transition pressure (for hybrid coord.)
+      preff=610.      ! reference surface pressure
+ 
+c Aerosol properties
+c --------------------------------
+      tauvis=0.2 ! default value for tauvis (dust opacity)
+      write(*,'("Reference dust opacity at ",f4.0," Pa ?")')odpref
+      call getin("tauvis",tauvis)
+      write(*,*) " tauvis = ",tauvis
+
+c Orbital parameters
+c ------------------
+      print *,'Min. distance Sun-Mars (Mkm)?'
+      call getin("periheli",periheli)
+      write(*,*) " periheli = ",periheli
+
+      print *,'Max. distance Sun-Mars (Mkm)?'
+      call getin("aphelie",aphelie)
+      write(*,*) " aphelie = ",aphelie
+
+      print *,'Day of perihelion?'
+      call getin("periday",peri_day)
+      write(*,*) " periday = ",peri_day
+
+      print *,'Obliquity?'
+      call getin("obliquit",obliquit)
+      write(*,*) " obliquit = ",obliquit
+ 
+c  latitude/longitude
+c  ------------------
+      latitude(1)=0 ! default value for latitude
+      PRINT *,'latitude (in degrees) ?'
+      call getin("latitude",latitude(1))
+      write(*,*) " latitude = ",latitude
+      latitude=latitude*pi/180.E+0
+      longitude=0.E+0
+      longitude=longitude*pi/180.E+0
+
+!  some initializations (some of which have already been
+!  done above!) and loads parameters set in callphys.def
+!  and allocates some arrays 
+!Mars possible matter with dtphys in input and include!!!
+      call phys_state_var_init(1,llm,nq,
+     .          daysec,dtphys,rad,g,r,cpp)
+      call ini_fillgeom(1,latitude,longitude,(/1.0/))
+      call conf_phys(1,llm,nq)
+
+
+c  Initialize albedo / soil thermal inertia
+c  ----------------------------------------
+c
+      albedodat(1)=0.2 ! default value for albedodat
+      PRINT *,'Albedo of bare ground ?'
+      call getin("albedo",albedodat(1))
+      write(*,*) " albedo = ",albedodat(1)
+
+      inertiedat(1,1)=400 ! default value for inertiedat
+      PRINT *,'Soil thermal inertia (SI) ?'
+      call getin("inertia",inertiedat(1,1))
+      write(*,*) " inertia = ",inertiedat(1,1)
+
+      z0(1)=z0_default ! default value for roughness
+      write(*,*) 'Surface roughness length z0 (m)?'
+      call getin("z0",z0(1))
+      write(*,*) " z0 = ",z0(1)
+
+! Initialize local slope parameters (only matters if "callslope"
+! is .true. in callphys.def)
+      ! slope inclination angle (deg) 0: horizontal, 90: vertical
+      theta_sl(1)=0.0 ! default: no inclination
+      call getin("slope_inclination",theta_sl(1))
+      ! slope orientation (deg)
+      ! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward
+      psi_sl(1)=0.0 ! default value
+      call getin("slope_orientation",psi_sl(1))
+      
+c
+c  for the gravity wave scheme
+c  ---------------------------------
+c
+      zmea(1)=0.E+0
+      zstd(1)=0.E+0
+      zsig(1)=0.E+0
+      zgam(1)=0.E+0
+      zthe(1)=0.E+0
+
+
+c   Specific initializations for "physiq"
+c   -------------------------------------
+c   mesh surface (not a very usefull quantity in 1D)
+      area(1)=1.E+0
+
+c   surface geopotential is not used (or useful) since in 1D
+c   everything is controled by surface pressure
+      phisfi(1)=0.E+0
+
+c   Initialization to take into account prescribed winds
+c   ------------------------------------------------------
+      ptif=2.E+0*omeg*sinlat(1)
+ 
+c    geostrophic wind
+      gru=10. ! default value for gru
+      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
+      call getin("u",gru)
+      write(*,*) " u = ",gru
+      grv=0. !default value for grv
+      PRINT *,'meridional northward component of the geostrophic',
+     &' wind (m/s) ?'
+      call getin("v",grv)
+      write(*,*) " v = ",grv
+
+c     Initialize winds  for first time step
+      DO ilayer=1,nlayer
+         u(ilayer)=gru
+         v(ilayer)=grv
+      ENDDO
+
+c     Initialize turbulente kinetic energy
+      DO ilevel=1,nlevel
+         q2(ilevel)=0.E+0
+      ENDDO
+
+c  CO2 ice on the surface
+c  -------------------
+      co2ice(1)=0.E+0 ! default value for co2ice
+      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
+      call getin("co2ice",co2ice)
+      write(*,*) " co2ice = ",co2ice
+
+c
+c  emissivity
+c  ----------
+      emis=emissiv
+      IF (co2ice(1).eq.1.E+0) THEN
+         emis=emisice(1) ! northern hemisphere
+         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
+      ENDIF
+
+ 
+
+c  Compute pressures and altitudes of atmospheric levels 
+c  ----------------------------------------------------------------
+
+c    Vertical Coordinates
+c    """"""""""""""""""""
+      hybrid=.true.
+      PRINT *,'Hybrid coordinates ?'
+      call getin("hybrid",hybrid)
+      write(*,*) " hybrid = ", hybrid
+
+      CALL  disvert
+
+      DO ilevel=1,nlevel
+        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+      ENDDO
+
+      DO ilayer=1,nlayer
+        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
+     &   /g
+      ENDDO
+
+
+c  Initialize temperature profile
+c  --------------------------------------
+      pks=psurf**rcp
+
+c altitude in km in profile: divide zlay by 1000
+      tmp1(0)=0.E+0
+      DO ilayer=1,nlayer
+        tmp1(ilayer)=zlay(ilayer)/1000.E+0
+      ENDDO
+
+      call profile(nlayer+1,tmp1,tmp2)
+
+      tsurf=tmp2(0)
+      DO ilayer=1,nlayer
+        temp(ilayer)=tmp2(ilayer)
+      ENDDO
+      
+
+
+! Initialize soil properties and temperature
+! ------------------------------------------
+      volcapa=1.e6 ! volumetric heat capacity
+      DO isoil=1,nsoil
+         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
+         tsoil(isoil)=tsurf(1)  ! soil temperature
+      ENDDO
+
+! Initialize depths
+! -----------------
+      do isoil=0,nsoil-1
+        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
+      enddo
+      do isoil=1,nsoil
+        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
+      enddo
+
+c    Initialize traceurs
+c    ---------------------------
+
+      if (photochem.or.callthermos) then
+         write(*,*) 'Initializing chemical species'
+         ! thermo=0: initialize over all atmospheric layers
+         thermo=0
+         call inichim_newstart(q,psurf,sig,nq,lati,long,area,
+     $   thermo,qsurf)
+      endif
+
+c Check if the surface is a water ice reservoir 
+c --------------------------------------------------
+      watercaptag(1)=.false. ! Default: no water ice reservoir
+      print *,'Water ice cap on ground ?'
+      call getin("watercaptag",watercaptag)
+      write(*,*) " watercaptag = ",watercaptag
+      
+
+c    Initialization for GRADS outputs in "g1d.dat" and "g1d.ctl"
+c    ----------------------------------------------------------------
+c    (output done in "writeg1d", typically called by "physiq.F")
+
+        g1d_nlayer=nlayer
+        g1d_nomfich='g1d.dat'
+        g1d_unitfich=40
+        g1d_nomctl='g1d.ctl'
+        g1d_unitctl=41
+        g1d_premier=.true.
+        g2d_premier=.true.
+
+c  Write a "startfi" file
+c  --------------------
+c  This file will be read during the first call to "physiq".
+c  It is needed to transfert physics variables to "physiq"...
+
+      call physdem0("startfi.nc",long,lati,nsoilmx,ngrid,llm,nq,
+     .              dtphys,float(day0),time,area,
+     .              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
+      call physdem1("startfi.nc",nsoilmx,ngrid,llm,nq,
+     .              dtphys,time,
+     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
+
+c=======================================================================
+c  1D MODEL TIME STEPPING LOOP
+c=======================================================================
+c
+      firstcall=.true.
+      lastcall=.false.
+
+      DO idt=1,ndt
+c        IF (idt.eq.ndt) lastcall=.true.
+        IF (idt.eq.ndt-day_step-1) then       !test
+         lastcall=.true.
+         call solarlong(day*1.0,zls)
+         write(103,*) 'Ls=',zls*180./pi
+         write(103,*) 'Lat=', lati(1)*180./pi
+         write(103,*) 'Tau=', tauvis/odpref*psurf
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(103,*) 'RunEnd - Atmos. Temp. File'
+         write(104,*) 'Ls=',zls*180./pi
+         write(104,*) 'Lat=', lati(1)
+         write(104,*) 'Tau=', tauvis/odpref*psurf
+         write(104,*) 'RunEnd - Atmos. Temp. File'
+        ENDIF
+
+c     compute geopotential
+c     ~~~~~~~~~~~~~~~~~~~~~
+      DO ilayer=1,nlayer
+        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
+        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
+      ENDDO
+      phi(1)=pks*h(1)*(1.E+0-s(1))
+      DO ilayer=2,nlayer
+         phi(ilayer)=phi(ilayer-1)+
+     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
+     &                  *(s(ilayer-1)-s(ilayer))
+
+      ENDDO
+
+c       call physics
+c       --------------------
+!      write(*,*) "testphys1d avant q", q(1,:)
+      CALL physiq (1,llm,nq,
+     ,     firstcall,lastcall,
+     ,     day,time,dtphys,
+     ,     plev,play,phi,
+     ,     u, v,temp, q,  
+     ,     w,
+C - outputs
+     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
+!      write(*,*) "testphys1d apres q", q(1,:)
+
+
+c       wind increment : specific for 1D
+c       --------------------------------
+ 
+c       The physics compute the tendencies on u and v,
+c       here we just add Coriolos effect
+c
+c       DO ilayer=1,nlayer
+c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
+c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
+c       ENDDO
+
+c       For some tests : No coriolis force at equator
+c       if(lati(1).eq.0.) then
+          DO ilayer=1,nlayer
+             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
+             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
+          ENDDO
+c       end if
+c      
+c
+c       Compute time for next time step
+c       ---------------------------------------
+        firstcall=.false.
+        time=time+dtphys/daysec
+        IF (time.gt.1.E+0) then
+            time=time-1.E+0
+            day=day+1
+        ENDIF
+
+c       compute winds and temperature for next time step
+c       ----------------------------------------------------------
+
+        DO ilayer=1,nlayer
+           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
+           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
+           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
+        ENDDO
+
+c       compute pressure for next time step 
+c       ----------------------------------------------------------
+
+           psurf=psurf+dtphys*dpsurf   ! surface pressure change
+           DO ilevel=1,nlevel
+             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
+           ENDDO
+           DO ilayer=1,nlayer
+             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
+           ENDDO
+
+!       increment tracers
+        DO iq = 1, nq
+          DO ilayer=1,nlayer
+             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
+          ENDDO
+        ENDDO
+
+      ENDDO   ! of idt=1,ndt ! end of time stepping loop
+
+c    ========================================================
+c    OUTPUTS
+c    ========================================================
+
+c    finalize and close grads files "g1d.dat" and "g1d.ctl"
+
+c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
+        CALL endg1d(1,nlayer,zlay/1000.,ndt)
+
+      write(*,*) "testphys1d: Everything is cool."
+
+      END
+ 
+c***********************************************************************
+c***********************************************************************
+c     Dummy subroutines used only in 3D, but required to
+c     compile testphys1d (to cleanly use writediagfi)
+
+      subroutine gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+
+      IMPLICIT NONE
+
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+      
+      if (ngrid.ne.1) then
+        write(*,*) "gr_fi_dyn error: in 1D ngrid should be 1!!!"
+        stop
+      endif
+      
+      pdyn(1,1,1:nfield)=pfi(1,1:nfield)
+      
+      end
+ 
+c***********************************************************************
+c***********************************************************************
+
+#include "../dyn3d/disvert.F"
+#include "../dyn3d/abort_gcm.F"
Index: trunk/LMDZ.MARS/libf/phymars/ini_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/ini_archive.F	(revision 1399)
+++ 	(revision )
@@ -1,523 +1,0 @@
-c=======================================================================
-      subroutine ini_archive(nid,idayref,phis,ith,tab_cntrl_fi)
-c=======================================================================
-c
-c
-c   Date:    01/1997
-c   ----
-c
-c   Objet:  ecriture de l'entete du fichier "start_archive"
-c   -----
-c
-c	 Proche de iniwrite.F
-c
-c	 On ajoute dans le tableau "tab_cntrl" (dynamique), a partir de 51, 
-c	 les valeurs de tab_cntrl_fi (les 38 parametres de controle physiques
-c	 du RUN + ptotal et cotoicetotal)
-c
-c			tab_cntrl(50+l)=tab_cntrl_fi(l)
-c
-c   Arguments:
-c   ---------
-c
-c	Inputs:
-c   ------
-c
-c       nid            unite logique du fichier "start_archive"
-c       idayref        Valeur du jour initial a mettre dans
-c                      l'entete du fichier "start_archive"
-c       phis           geopotentiel au sol
-c       ith            soil thermal inertia
-c       tab_cntrl_fi   tableau des param physiques
-c
-
-c=======================================================================
- 
-      use comsoil_h, only: nsoilmx, mlayer
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c   Declarations
-c-----------------------------------------------------------------------
-
-c   Local:
-c   ------
-      INTEGER	length,l
-      parameter (length = 100)
-      REAL		tab_cntrl(length) ! tableau des parametres du run
-      INTEGER	loop
-      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
-      INTEGER	setdim
-      INTEGER	ind1,indlast
-
-c   Arguments:
-c   ----------
-      INTEGER*4	idayref
-      REAL		phis(ip1jmp1)
-      real ith(ip1jmp1,nsoilmx)
-      REAL		tab_cntrl_fi(length)
-
-!Mars --------Ajouts-----------
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3) !, dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_llmp1,idim_llm
-      INTEGER idim_tim
-      INTEGER idim_nsoilmx ! "subsurface_layers" dimension ID #
-      INTEGER nid,nvarid
-      real sig_s(llm),s(llm)
-
-      pi  = 2. * ASIN(1.)
-
-
-c-----------------------------------------------------------------------
-c   Remplissage du tableau des parametres de controle du RUN  (dynamique)
-c-----------------------------------------------------------------------
-
-      DO l=1,length
-         tab_cntrl(l)=0.
-      ENDDO
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      tab_cntrl(1)  = REAL(iim) ! nombre de points en longitude
-      tab_cntrl(2)  = REAL(jjm) ! nombre de points en latitude
-      tab_cntrl(3)  = REAL(llm) ! nombre de couches
-      tab_cntrl(4)  = REAL(idayref) ! jour 0
-      tab_cntrl(5)  = rad ! rayon de mars(m) ~3397200
-      tab_cntrl(6)  = omeg ! vitesse de rotation (rad.s-1)
-      tab_cntrl(7)  = g   ! gravite (m.s-2) ~3.72
-      tab_cntrl(8)  = cpp 
-      tab_cntrl(8)  = 43.49 !mars temporaire Masse molaire de l''atm (g.mol-1) ~43.49
-      tab_cntrl(9)  = kappa ! = r/cp  ~0.256793 (=rcp dans physique)
-      tab_cntrl(10) = daysec ! duree du sol (s)  ~88775
-      tab_cntrl(11) = dtvr ! pas de temps de la dynamique (s)
-      tab_cntrl(12) = etot0 ! energie totale    !
-      tab_cntrl(13) = ptot0 ! pression totalei   !    variables
-      tab_cntrl(14) = ztot0 ! enstrophie totale   !  de controle
-      tab_cntrl(15) = stot0 ! enthalpie totale   !    globales
-      tab_cntrl(16) = ang0 ! moment cinetique  !
-      tab_cntrl(17) = pa
-      tab_cntrl(18) = preff
-
-c    .....    parametres  pour le zoom      ......   
-
-      tab_cntrl(19)  = clon ! longitude en degres du centre du zoom
-      tab_cntrl(20)  = clat ! latitude en degres du centre du zoom
-      tab_cntrl(21)  = grossismx ! facteur de grossissement du zoom,selon longitude
-      tab_cntrl(22)  = grossismy ! facteur de grossissement du zoom ,selon latitude
-
-      IF ( fxyhypb )   THEN
-       tab_cntrl(23) = 1.
-       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-      ELSE
-       tab_cntrl(23) = 0.
-       tab_cntrl(24) = dzoomx ! extension en longitude  de la zone du zoom
-       tab_cntrl(25) = dzoomy ! extension en latitude  de la zone du zoom
-       tab_cntrl(26) = 0.
-       IF ( ysinus)  tab_cntrl(26) = 1.
-      ENDIF
-
-c-----------------------------------------------------------------------
-c   Copie du tableau des parametres de controle du RUN  (physique)
-c		dans le tableau dynamique
-c-----------------------------------------------------------------------
-
-      DO l=1,50
-         tab_cntrl(50+l)=tab_cntrl_fi(l)
-      ENDDO
-
-c=======================================================================
-c	Ecriture NetCDF de l''entete du fichier "start_archive"
-c=======================================================================
-
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 21,
-     &                       "Fichier start_archive")
-c
-c Definir les dimensions du fichiers:
-c
-c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
-      ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
-      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
-
-      ierr = NF_DEF_DIM (nid,"index", length, idim_index)
-      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid,"interlayer", llmp1, idim_llmp1)
-      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
-
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-
-c-----------------------------------------------------------------------
-c  Ecriture du tableau des parametres du run
-c-----------------------------------------------------------------------
-
-      call def_var(nid,"Time","Time","days since 00:00:00",1,
-     .            idim_tim,nvarid,ierr)
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-
-c-----------------------------------------------------------------------
-c  Ecriture des longitudes et latitudes
-c-----------------------------------------------------------------------
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
-     .                       "Longitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
-#endif
-
-c-----------------------------------------------------------------------
-c  Ecriture des niveaux verticaux
-c-----------------------------------------------------------------------
-
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Coef A: niveaux pression hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
-     .                       "Coefficient B niveaux sigma hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
-#endif
-c
-c ----------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 36,
-     .      "Coef AS: hybrid pressure in midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
-#endif
-c
-c ----------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bps",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bps",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 30,
-     .      "Coef BS: hybrid sigma midlayers")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
-#endif
-c
-c ----------------------
-
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
-#endif
-c ------------------------------------------------------------------
-c  Variable uniquement pour visualisation avec Grads ou Ferret
-c ------------------------------------------------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"latitude",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"latitude",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
-      ierr =NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "North latitude")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
-#endif
-c----------------------
-       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr =NF_DEF_VAR(nid,"longitude", NF_DOUBLE, 1, idim_rlonv,nvarid)
-#else
-      ierr = NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, idim_rlonv,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 14,
-     .      "East longitude")
-      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
-#endif
-c--------------------------
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1,
-     .       idim_llm,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1,
-     .       idim_llm,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"long_name",10,"pseudo-alt")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'units',2,"km")
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,'positive',2,"up")
-
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,pseudoalt)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,pseudoalt)
-#endif
-
-!-------------------------------
-! (soil) depth variable mlayer() (known from comsoil.h)
-!-------------------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_DOUBLE,1,idim_nsoilmx,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"soildepth",NF_FLOAT,1,idim_nsoilmx,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     .                        "Soil mid-layer depth")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",1,"m")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"positive",4,"down")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,mlayer)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,mlayer)
-#endif
-
-!---------------------
-! soil thermal inertia
-!---------------------
-      ierr=NF_REDEF (nid) ! Enter NetCDF (re-)define mode
-      dims3(1)=idim_rlonv
-      dims3(2)=idim_rlatu
-      dims3(3)=idim_nsoilmx
-      ! define variable
-#ifdef NC_DOUBLE
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr=NF_DEF_VAR(nid,"inertiedat",NF_FLOAT,3,dims3,nvarid)
-#endif
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"long_name", 20,
-     &                        "Soil thermal inertia")
-      ierr=NF_PUT_ATT_TEXT (nid,nvarid,"units",15,
-     &                        "J.s-1/2.m-2.K-1")
-      ierr=NF_ENDDEF(nid) ! Leave NetCDF define mode
-      ! write variable
-#ifdef NC_DOUBLE
-      ierr=NF_PUT_VAR_DOUBLE (nid,nvarid,ith)
-#else
-      ierr=NF_PUT_VAR_REAL (nid,nvarid,ith)
-#endif
-
-c-----------------------------------------------------------------------
-c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
-c-----------------------------------------------------------------------
-
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour U")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
-#endif
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatv
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
-     .                       "Coefficient de passage pour V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
-#endif
-c
-c Aire de chaque maille:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
-#endif
-
-c-----------------------------------------------------------------------
-c  Ecriture du geopentiel au sol
-c-----------------------------------------------------------------------
-
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
-#endif
-
-      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
-      PRINT*,'rad,omeg,g,mugaz,kappa',
-     s rad,omeg,g,43.49,kappa !mars temporaire (ecrire mugaz ensuite)
-      PRINT*,'daysec,dtvr',daysec,dtvr
-
-      RETURN
-      END
Index: trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/iniphysiq.F90	(revision 1399)
+++ 	(revision )
@@ -1,142 +1,0 @@
-subroutine iniphysiq(ii,jj,nlayer,punjours, pdayref,ptimestep,           &
-                     rlatu,rlonv,aire,cu,cv,                             &
-                     prad,pg,pr,pcpp,iflag_phys)
-
-use dimphy, only : klev ! number of atmospheric levels
-use mod_grid_phy_lmdz, only : klon_glo ! number of atmospheric columns
-                                       ! (on full grid)
-use mod_phys_lmdz_para, only : klon_omp, & ! number of columns (on local omp grid)
-                               klon_omp_begin, & ! start index of local omp subgrid
-                               klon_omp_end, & ! end index of local omp subgrid
-                               klon_mpi_begin ! start indes of columns (on local mpi grid)
-
-use comgeomphy, only : initcomgeomphy, &
-                       airephy, & ! physics grid area (m2)
-                       cuphy, & ! cu coeff. (u_covariant = cu * u)
-                       cvphy, & ! cv coeff. (v_covariant = cv * v)
-                       rlond, & ! longitudes
-                       rlatd ! latitudes
-use infotrac, only : nqtot ! number of advected tracers
-use comgeomfi_h, only: ini_fillgeom
-
-implicit none
-
-include "iniprint.h"
-
-real,intent(in) :: prad ! radius of the planet (m)
-real,intent(in) :: pg ! gravitational acceleration (m/s2)
-real,intent(in) :: pr ! ! reduced gas constant R/mu
-real,intent(in) :: pcpp ! specific heat Cp
-real,intent(in) :: punjours ! length (in s) of a standard day
-!integer,intent(in) :: ngrid ! number of horizontal grid points in the physics (full grid)
-integer,intent(in) :: nlayer ! number of atmospheric layers
-integer,intent(in) :: ii ! number of atmospheric coulumns along longitudes
-integer,intent(in) :: jj  ! number of atompsheric columns along latitudes
-real,intent(in) :: rlatu(jj+1) ! latitudes of the dynamics U grid
-real,intent(in) :: rlonv(ii+1) ! longitudes of the dynamics V grid
-real,intent(in) :: aire(ii+1,jj+1) ! area of the dynamics grid (m2)
-real,intent(in) :: cu((ii+1)*(jj+1)) ! cu coeff. (u_covariant = cu * u)
-real,intent(in) :: cv((ii+1)*jj) ! cv coeff. (v_covariant = cv * v)
-integer,intent(in) :: pdayref ! reference day of for the simulation
-real,intent(in) :: ptimestep !physics time step (s)
-integer,intent(in) :: iflag_phys ! type of physics to be called
-
-integer :: ibegin,iend,offset
-integer :: i,j
-character(len=20) :: modname='iniphysiq'
-character(len=80) :: abort_message
-real :: total_area_phy, total_area_dyn
-
-
-! global array, on full physics grid:
-real,allocatable :: latfi(:)
-real,allocatable :: lonfi(:)
-real,allocatable :: cufi(:)
-real,allocatable :: cvfi(:)
-real,allocatable :: airefi(:)
-
-IF (nlayer.NE.klev) THEN
-  write(*,*) 'STOP in ',trim(modname)
-  write(*,*) 'Problem with dimensions :'
-  write(*,*) 'nlayer     = ',nlayer
-  write(*,*) 'klev   = ',klev
-  abort_message = ''
-  CALL abort_gcm (modname,abort_message,1)
-ENDIF
-
-!IF (ngrid.NE.klon_glo) THEN
-!  write(*,*) 'STOP in ',trim(modname)
-!  write(*,*) 'Problem with dimensions :'
-!  write(*,*) 'ngrid     = ',ngrid
-!  write(*,*) 'klon   = ',klon_glo
-!  abort_message = ''
-!  CALL abort_gcm (modname,abort_message,1)
-!ENDIF
-
-! Generate global arrays on full physics grid
-allocate(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
-latfi(1)=rlatu(1)
-lonfi(1)=0.
-cufi(1) = cu(1)
-cvfi(1) = cv(1)
-DO j=2,jj
-  DO i=1,ii
-    latfi((j-2)*ii+1+i)= rlatu(j)
-    lonfi((j-2)*ii+1+i)= rlonv(i)
-    cufi((j-2)*ii+1+i) = cu((j-1)*ii+1+i)
-    cvfi((j-2)*ii+1+i) = cv((j-1)*ii+1+i)
-  ENDDO
-ENDDO
-latfi(klon_glo)= rlatu(jj+1)
-lonfi(klon_glo)= 0.
-cufi(klon_glo) = cu((ii+1)*jj+1)
-cvfi(klon_glo) = cv((ii+1)*jj-ii)
-
-! build airefi(), mesh area on physics grid
-allocate(airefi(klon_glo))
-CALL gr_dyn_fi(1,ii+1,jj+1,klon_glo,aire,airefi)
-! Poles are single points on physics grid
-airefi(1)=sum(aire(1:ii,1))
-airefi(klon_glo)=sum(aire(1:ii,jj+1))
-
-! Sanity check: do total planet area match between physics and dynamics?
-total_area_dyn=sum(aire(1:ii,1:jj+1))
-total_area_phy=sum(airefi(1:klon_glo))
-IF (total_area_dyn/=total_area_phy) THEN
-  WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
-  WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
-  WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
-  IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
-    ! stop here if the relative difference is more than 0.001%
-    abort_message = 'planet total surface discrepancy'
-    CALL abort_gcm(modname, abort_message, 1)
-  ENDIF
-ENDIF
-
-
-
-!$OMP PARALLEL 
-! Now generate local lon/lat/cu/cv/area arrays
-call initcomgeomphy
-
-!!!!$OMP PARALLEL PRIVATE(ibegin,iend) 
-!!!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
-      
-offset=klon_mpi_begin-1
-airephy(1:klon_omp)=airefi(offset+klon_omp_begin:offset+klon_omp_end)
-cuphy(1:klon_omp)=cufi(offset+klon_omp_begin:offset+klon_omp_end)
-cvphy(1:klon_omp)=cvfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlond(1:klon_omp)=lonfi(offset+klon_omp_begin:offset+klon_omp_end)
-rlatd(1:klon_omp)=latfi(offset+klon_omp_begin:offset+klon_omp_end)
-
-! copy some fundamental parameters to physics 
-! and do some initializations 
-call phys_state_var_init(klon_omp,nlayer,nqtot, &
-                         punjours,ptimestep,prad,pg,pr,pcpp)
-call ini_fillgeom(klon_omp,rlatd,rlond,airephy)
-call conf_phys(klon_omp,nlayer,nqtot)
-
-!$OMP END PARALLEL
-
-
-end subroutine iniphysiq
Index: trunk/LMDZ.MARS/libf/phymars/lect_start_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/lect_start_archive.F	(revision 1399)
+++ 	(revision )
@@ -1,1432 +1,0 @@
-      SUBROUTINE lect_start_archive(ngrid,nlayer,nqtot,
-     &     date,tsurf,tsoil,emis,q2,
-     &     t,ucov,vcov,ps,co2ice,h,phisold_newgrid,
-     &     q,qsurf,tauscaling,surfith,nid)
-c=======================================================================
-c
-c
-c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
-c   ------
-c
-c
-c   Objet:     Lecture des variables d'un fichier "start_archive"
-c              Plus besoin de régler ancienne valeurs grace
-c              a l'allocation dynamique de memoire (Yann Wanherdrick)
-c
-c
-c
-c=======================================================================
-      use infotrac, only: tname
-      use comsoil_h, only: nsoilmx, layer, mlayer, volcapa, inertiedat
-      use planete_h
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "description.h"
-#include "ener.h"
-#include "temps.h"
-#include "netcdf.inc"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-! routine arguments
-! -----------------
-      integer,intent(in) :: ngrid ! number of atmosphferic columns
-                                  ! on new physics grid
-      integer,intent(in) :: nlayer ! number of atmospheric layers
-                                   ! on new grid
-      integer,intent(in) :: nqtot ! number of advected tracers
-      REAL,INTENT(OUT) :: date
-      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
-      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
-      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
-      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
-      REAL,INTENT(OUT) :: co2ice(ngrid) ! CO2 ice layer
-      REAL,INTENT(OUT) :: emis(ngrid)
-      REAL,INTENT(OUT) :: q2(ngrid,nlayer+1),qsurf(ngrid,nqtot)
-      REAL,INTENT(OUT) :: tauscaling(ngrid) ! dust conversion factor
-      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
-      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
-      real,intent(in) :: surfith(iip1,jjp1) ! surface thermal inertia
-      INTEGER,INTENT(IN) :: nid ! input NetCDF file identifier
-
-
-
-c Old variables dimensions (from file)
-c------------------------------------
-      INTEGER   imold,jmold,lmold,nsoilold,nqold
-
-c Variables pour les lectures des fichiers "ini" 
-c--------------------------------------------------
-!      INTEGER sizei,
-      integer timelen,dimid
-!      INTEGER length
-!      parameter (length = 100)
-      INTEGER tab0
-      INTEGER isoil,iq,iqmax
-      CHARACTER*2   str2
-
-!      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
-
-!      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
-
-!      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
-!      CHARACTER*120 dimsource
-!      CHARACTER*16 dimname
-!      CHARACTER*80 dimtitle
-!      CHARACTER*40 dimunits
-!      INTEGER   dimtype
-
-!      INTEGER dimord(4)  ! tableau contenant l''ordre
-!      data dimord /1,2,3,4/ ! de sortie des dimensions
-
-!      INTEGER vardim(4)
-      INTEGER   memo
-!      character (len=50) :: tmpname
-
-c Variable histoire 
-c------------------
-      REAL ::qtot(iip1,jjp1,llm)
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-
-c!-*-
-!      integer klatdat,klongdat
-!      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-
-c variable physique
-c------------------
-c     REAL phisfi(ngrid)
-
-      INTEGER i,j,l
-      INTEGER nvarid
-c     REAL year_day,periheli,aphelie,peri_day
-c     REAL obliquit,z0,emin_turb,lmixmin
-c     REAL emissiv,emisice(2),albedice(2),tauvis
-c     REAL iceradius(2) , dtemisice(2)
-
-!      EXTERNAL RAN1
-!      REAL RAN1
-!      EXTERNAL geopot,inigeom
-      integer ierr
-!      integer ismin
-!      external ismin
-!      CHARACTER*80 datapath
-      integer, dimension(4) :: start,count
-
-c Variable nouvelle grille naturelle au point scalaire
-c------------------------------------------------------
-      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
-      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
-      real inertiedatS(iip1,jjp1,nsoilmx)
-      real co2iceS(iip1,jjp1),emisS(iip1,jjp1)
-      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
-      real tauscalingS(iip1,jjp1)
-
-      real ptotal, co2icetotal
-
-c Var intermediaires : vent naturel, mais pas coord scalaire
-c-----------------------------------------------------------
-      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
-
-
-c Variable de l'ancienne grille 
-c---------------------------------------------------------
-
-      real, dimension(:), allocatable :: timelist
-      real, dimension(:), allocatable :: rlonuold, rlatvold
-      real, dimension(:), allocatable :: rlonvold, rlatuold
-      real, dimension(:), allocatable :: apsold,bpsold
-      real, dimension(:), allocatable :: mlayerold
-      real, dimension(:,:,:), allocatable :: uold,vold,told,q2old
-      real, dimension(:,:,:), allocatable :: tsoilold,qsurfold
-      real, dimension(:,:,:),allocatable :: tsoiloldnew
-! tsoiloldnew: old soil values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatold
-! inertiedatoldnew: old inertia values, but along new subterranean grid
-      real, dimension(:,:,:), allocatable :: inertiedatoldnew
-      real, dimension(:,:), allocatable :: psold,phisold
-      real, dimension(:,:), allocatable :: co2iceold,tsurfold
-      real, dimension(:,:), allocatable :: emisold
-      real, dimension(:,:,:,:), allocatable :: qold
-      real, dimension(:,:), allocatable :: tauscalingold
-
-      real tab_cntrl(100)
-
-      real ptotalold, co2icetotalold
-
-      logical :: olddepthdef=.false. ! flag
-! olddepthdef=.true. if soil depths are in 'old' (unspecified) format
-      logical :: depthinterpol=.false. ! flag
-! depthinterpol=.true. if interpolation will be requiered
-      logical :: therminertia_3D=.true. ! flag
-! therminertia_3D=.true. if thermal inertia is 3D and read from datafile
-c Variable intermediaires iutilise pour l'extrapolation verticale 
-c----------------------------------------------------------------
-      real, dimension(:,:,:), allocatable :: var,varp1 
-      real, dimension(:), allocatable :: oldgrid, oldval
-      real, dimension(:), allocatable :: newval
-!      real, dimension(:), allocatable :: oldmlayer
-
-!      real surfithfi(ngrid)
-      ! surface thermal inertia at old horizontal grid resolution
-      real, dimension(:,:), allocatable :: surfithold 
-
-! flag which identifies if archive file is using old tracer names (qsurf01,...)
-      logical :: oldtracernames=.false.
-      integer :: counter
-      character(len=30) :: txt ! to store some text
-      real :: tmpval ! to store a temporary variable/value
-
-c=======================================================================
-
-! 0. Preliminary stuff
-
-! check if tracers follow old naming convention (q01, q02, q03, ...)
-      counter=0
-      do iq=1,nqtot
-        txt= " "
-        write(txt,'(a1,i2.2)')'q',iq
-        ierr=NF_INQ_VARID(nid,txt,nvarid)
-        if (ierr.ne.NF_NOERR) then
-          ! did not find old tracer name
-          exit ! might as well stop here
-        else
-          ! found old tracer name
-          counter=counter+1
-        endif
-      enddo
-      if (counter.eq.nqtot) then
-        write(*,*) "lect_start_archive: tracers seem to follow old ",
-     &             "naming convention (q01, q02,...)"
-        oldtracernames=.true.
-      endif
-
-
-!-----------------------------------------------------------------------
-! 1. Read data dimensions (i.e. size and length)
-!-----------------------------------------------------------------------
-
-! 1.2 Read the various dimension lengths of data in file 
-
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"temps",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find Time length'
-        stop
-      else
-        write(*,*) "lect_start_archive: timelen=",timelen
-      endif
-
-      ierr= NF_INQ_DIMID(nid,"latitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlatu",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,jmold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find lat length'
-        stop
-      else
-        write(*,*) "lect_start_archive: jmold=",jmold
-      endif
-      jmold=jmold-1
-
-      ierr= NF_INQ_DIMID(nid,"longitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"rlonv",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,imold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find lon length'
-        stop
-      else
-        write(*,*) "lect_start_archive: imold=",imold
-      endif
-      imold=imold-1
-
-      ierr= NF_INQ_DIMID(nid,"altitude",dimid)
-      if (ierr.ne.NF_NOERR) then
-         ierr= NF_INQ_DIMID(nid,"sig_s",dimid)
-      endif
-      ierr= NF_INQ_DIMLEN(nid,dimid,lmold)
-      if (ierr.ne.NF_NOERR) then
-        write(*,*) 'lect_start_archive error: cannot find alt length'
-        stop
-      else
-        write(*,*) "lect_start_archive: lmold=",lmold
-      endif
-
-      nqold=0
-      do
-         write(str2,'(i2.2)') nqold+1
-         ierr= NF_INQ_VARID(nid,'q'//str2,dimid)
-!        write(*,*) 'q'//str2
-         if (ierr.eq.NF_NOERR) then
-            nqold=nqold+1
-         else
-            exit
-         endif
-      enddo
-
-! 1.2.1 find out the # of subsurface_layers
-      nsoilold=0 !dummy initialisation
-      ierr=NF_INQ_DIMID(nid,"subsurface_layers",dimid)
-      if (ierr.eq.NF_NOERR) then
-        ierr=NF_INQ_DIMLEN(nid,dimid,nsoilold)
-	if (ierr.ne.NF_NOERR) then
-	 write(*,*)'lec_start_archive: ',
-     &              'Failed reading subsurface_layers length'
-	endif
-      else
-        write(*,*)"lec_start_archive: did not find subsurface_layers"
-      endif
-
-      if (nsoilold.eq.0) then ! 'old' archive format;
-      ! must use Tg//str2 fields to compute nsoilold
-      write(*,*)"lec_start_archive: building nsoilold from Tg fields"
-        do
-	 write(str2,'(i2.2)') nsoilold+1
-	 ierr=NF_INQ_VARID(nid,'Tg'//str2,dimid)
-	 if (ierr.eq.NF_NOERR) then
-	  nsoilold=nsoilold+1
-	 else
-	  exit
-	 endif
-	enddo
-      endif
-
-
-      if (nsoilold.ne.nsoilmx) then ! interpolation will be required
-        depthinterpol=.true.
-      endif
-
-! 1.3 Report dimensions
-      
-      write(*,*) "lect_start_archive: Start_archive dimensions:"
-      write(*,*) "longitude: ",imold
-      write(*,*) "latitude: ",jmold
-      write(*,*) "altitude: ",lmold
-      if (nqold.gt.0) then
-        write(*,*) "old tracers q*: ",nqold
-      endif
-      write(*,*) "subsurface_layers: ",nsoilold
-      if (depthinterpol) then
-      write(*,*) " => Warning, nsoilmx= ",nsoilmx
-      write(*,*) '    which implies that you want subterranean interpola
-     &tion.'
-      write(*,*) '  Otherwise, set nsoilmx -in comsoil_h- to: ',nsoilold
-      endif
-      write(*,*) "time lenght: ",timelen
-      write(*,*) 
-
-!-----------------------------------------------------------------------
-! 2. Allocate arrays to store datasets
-!-----------------------------------------------------------------------
-
-      allocate(timelist(timelen))
-      allocate(rlonuold(imold+1), rlatvold(jmold))
-      allocate(rlonvold(imold+1), rlatuold(jmold+1))
-      allocate (apsold(lmold),bpsold(lmold))
-      allocate(uold(imold+1,jmold+1,lmold))
-      allocate(vold(imold+1,jmold+1,lmold))
-      allocate(told(imold+1,jmold+1,lmold))
-      allocate(psold(imold+1,jmold+1))
-      allocate(phisold(imold+1,jmold+1))
-      allocate(qold(imold+1,jmold+1,lmold,nqtot))
-      allocate(co2iceold(imold+1,jmold+1))
-      allocate(tsurfold(imold+1,jmold+1))
-      allocate(emisold(imold+1,jmold+1))
-      allocate(q2old(imold+1,jmold+1,lmold+1))
-!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
-      allocate(tsoilold(imold+1,jmold+1,nsoilold))
-      allocate(tsoiloldnew(imold+1,jmold+1,nsoilmx))
-      allocate(inertiedatold(imold+1,jmold+1,nsoilold)) ! soil thermal inertia
-      allocate(inertiedatoldnew(imold+1,jmold+1,nsoilmx))
-      ! surface thermal inertia at old horizontal grid resolution
-      allocate(surfithold(imold+1,jmold+1))
-      allocate(mlayerold(nsoilold))
-      allocate(qsurfold(imold+1,jmold+1,nqtot))
-      allocate(tauscalingold(imold+1,jmold+1))
-
-      allocate(var (imold+1,jmold+1,llm))
-      allocate(varp1 (imold+1,jmold+1,llm+1))
-
-      write(*,*) 'q2',ngrid,nlayer+1
-      write(*,*) 'q2S',iip1,jjp1,llm+1
-      write(*,*) 'q2old',imold+1,jmold+1,lmold+1
-
-!-----------------------------------------------------------------------
-! 3. Read time-independent data
-!-----------------------------------------------------------------------
-
-C-----------------------------------------------------------------------
-c 3.1. Lecture du tableau des parametres du run 
-c     (pour  la lecture ulterieure de "ptotalold" et "co2icetotalold")
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Lect_start_archive: <controle> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <controle>"
-         CALL abort
-      ENDIF
-c
-      tab0 = 50
-
-c-----------------------------------------------------------------------
-c 3.2 Lecture des longitudes et latitudes
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlonv> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <rlonv>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlatu> is missing"
-         CALL abort
-      ENDIF 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <rlatu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlonu> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <rlonu>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <rlatv> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <rlatv>"
-         CALL abort
-      ENDIF
-c
-
-c-----------------------------------------------------------------------
-c 3.3. Lecture des niveaux verticaux
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "aps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <aps> is missing"
-         apsold=0
-         PRINT*, "<aps> set to 0"
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apsold)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, apsold)
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: Failed loading <aps>"
-         ENDIF
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "bps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <bps> is missing"
-         PRINT*, "It must be an old start_archive, lets look for sig_s"
-         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "Nothing to do..."
-            CALL abort
-         ENDIF
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpsold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, bpsold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <bps>"
-         CALL abort
-      END IF
-
-c-----------------------------------------------------------------------
-c 3.4 Read Soil layers depths
-c-----------------------------------------------------------------------
-     
-      ierr=NF_INQ_VARID(nid,"soildepth",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <soildepth>'
-       write(*,*)' => Assuming this is an archive in old format'
-       olddepthdef=.true.
-       depthinterpol=.true.
-       ! this is how soil depth was defined in ye old days
-	do isoil=1,nsoilold
-	  mlayerold(isoil)=sqrt(887.75/3.14)*((2.**(isoil-0.5))-1.)
-	enddo
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayerold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayerold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-
-      endif !of if(ierr.ne.NF_NOERR)
-
-      ! Read (or build) mlayer()
-      if (depthinterpol) then
-       ! Build (default) new soil depths (mlayer(:) is in comsoil.h),
-       ! as in soil_settings.F
-       write(*,*)' => Building default soil depths'
-       do isoil=0,nsoilmx-1
-         mlayer(isoil)=2.e-4*(2.**(isoil-0.5))
-       enddo
-       write(*,*)' => mlayer: ',mlayer
-       ! Also build (default) new soil interlayer depth layer(:)
-       do isoil=1,nsoilmx
-         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
-     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
-       enddo
-       write(*,*)' =>  layer: ',layer
-      else ! read mlayer() from file
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,mlayer)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,mlayer)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <soildepth>"
-         CALL abort
-       endif
-       ! Also build (default) soil interlayer depth layer(:)
-       do isoil=1,nsoilmx
-         layer(isoil)=sqrt(mlayer(0)*mlayer(1))*
-     &                      ((mlayer(1)/mlayer(0))**(isoil-1))
-       enddo
-      endif ! of if (depthinterpol)
-
-c-----------------------------------------------------------------------
-c 3.5 Read Soil thermal inertia
-c-----------------------------------------------------------------------
-
-      ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-      if (ierr.ne.NF_NOERR) then
-       write(*,*)'lect_start_archive: Could not find <inertiedat>'
-       write(*,*)' => Assuming this is an archive in old format'
-       therminertia_3D=.false.
-       write(*,*)' => Thermal inertia will be read from reference file'
-       volcapa=1.e6
-       write(*,*)'    and soil volumetric heat capacity is set to ',
-     &           volcapa
-      else
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid,nvarid,inertiedatold)
-#else
-        ierr = NF_GET_VAR_REAL(nid,nvarid,inertiedatold)
-#endif
-       if (ierr .NE. NF_NOERR) then
-         PRINT*, "lect_start_archive: Failed reading <inertiedat>"
-         CALL abort
-       endif
-      endif
-
-c-----------------------------------------------------------------------
-c 3.6 Lecture geopotentiel au sol
-c-----------------------------------------------------------------------
-c
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <phisinit> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <phisinit>"
-         CALL abort
-      ENDIF
-
-C-----------------------------------------------------------------------
-c   lecture de "ptotalold" et "co2icetotalold"
-c-----------------------------------------------------------------------
-      ptotalold = tab_cntrl(tab0+49)
-      co2icetotalold = tab_cntrl(tab0+50)
- 
-c-----------------------------------------------------------------------
-c 4. Lecture du temps et choix
-c-----------------------------------------------------------------------
- 
-c  lecture du temps
-c
-      ierr = NF_INQ_DIMID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: <Time> is missing"
-            CALL abort
-         endif
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "Time", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         ierr = NF_INQ_VARID (nid, "temps", nvarid)
-      endif 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, timelist)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, timelist)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <Time>"
-         CALL abort
-      ENDIF
-c
-      write(*,*)
-      write(*,*)
-      write(*,*) 'Dates of the stored initial states:'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      pi=2.*ASIN(1.)
-      do i=1,timelen
-c       call solarlong(timelist(i),sollong(i))
-c       sollong(i) = sollong(i)*180./pi
-c        write(*,*) 'initial state at martian day: ',int(timelist(i))
-        write(*,*) 'initial state at martian day: ',timelist(i)
-c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
-c    .    sollong(i)
-      end do
-
-   6  FORMAT(i7,i7,f9.3)
- 
-      write(*,*)
-      write(*,*) 'Choose the martian day to use'
- 123  read(*,*,iostat=ierr) date
-      if(ierr.ne.0) goto 123
-      memo = 0
-      do i=1,timelen
-c        if (date.eq.int(timelist(i))) then
-        if (abs(date-timelist(i)).lt.0.01) then
-            memo = i
-        endif
-      end do
- 
-      if (memo.eq.0) then
-        write(*,*)
-        write(*,*)
-        write(*,*) 'Wrong value for day number !!'
-        write(*,*)
-        write(*,*) 'Dates of the stored initial states:'
-        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-        do i=1,timelen
-          write(*,*) 'initial state at martian day: ',timelist(i)
-c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
-        end do
-        goto 123
-      endif
-      
-!-----------------------------------------------------------------------
-! 5. Read (time-dependent) data from datafile
-!-----------------------------------------------------------------------
-
-
-c-----------------------------------------------------------------------
-c 5.1 Lecture des champs 2D (co2ice, emis,ps,tsurf,Tg[10], q2surf, tauscaling)
-c-----------------------------------------------------------------------
- 
-      start=(/1,1,memo,0/)
-      count=(/imold+1,jmold+1,1,0/)
-       
-      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <co2ice> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <co2ice>"
-         PRINT*, NF_STRERROR(ierr)
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "emis", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <emis> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,emisold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,emisold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <emis>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <ps> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,psold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,psold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <ps>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <tsurf> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tsurfold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tsurfold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <tsurf>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <q2surf> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <q2surf>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid, "tauscaling", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <tauscaling> not in file"
-         tauscalingold(:,:) = -1
-      ELSE
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tauscalingold)
-#else
-        ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tauscalingold)
-#endif
-        IF (ierr .NE. NF_NOERR) THEN
-           PRINT*, "lect_start_archive: Failed loading <tauscaling>"
-           PRINT*, NF_STRERROR(ierr)
-           CALL abort
-        ENDIF
-      ENDIF
-c
-      write(*,*)"lect_start_archive: rlonuold:"
-     &           ,rlonuold," rlatvold:",rlatvold
-      write(*,*)
-c
-
-c tracers: the 2 last ones are kept the 2 last one. 
-c the others keep their rank. ! No longer true.
-c -------------------------------------------
-! Surface tracers:      
-      qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0
-
-      DO iq=1,nqtot
-        IF (oldtracernames) THEN
-          txt=" "
-          write(txt,'(a5,i2.2)')'qsurf',iq
-        ELSE
-          txt=trim(tname(iq))//"_surf"
-          if (txt.eq."h2o_vap") then
-            ! There is no surface tracer for h2o_vap;
-            ! "h2o_ice" should be loaded instead
-            txt="h2o_ice_surf"
-            write(*,*) 'lect_start_archive: loading surface tracer',
-     &                     ' h2o_ice instead of h2o_vap'
-          endif
-        ENDIF ! of IF (oldtracernames)
-        write(*,*) "lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-          print*, "which (constant) value should it be initialized to?"
-          read(*,*) tmpval
-          qsurfold(1:imold+1,1:jmold+1,iq)=tmpval
-        ELSE ! tracer exists in file, load it
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#else
-          ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          qsurfold(1,1,iq))
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &             " Failed loading <",trim(txt),">"
-            stop
-          ENDIF
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-!-----------------------------------------------------------------------
-! 5.2 Read 3D subterranean fields
-!-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-!
-! Read soil temperatures
-!
-      if (olddepthdef) then ! tsoil stored using the 'old format'
-         start=(/1,1,memo,0/)
-         count=(/imold+1,jmold+1,1,0/) ! because the "Tg" are 2D datasets
-       do isoil=1,nsoilold
-!        write(*,*)'isoil',isoil
-         write(str2,'(i2.2)') isoil
-c
-         ierr = NF_INQ_VARID (nid, "Tg"//str2, nvarid)
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              "Field <","Tg"//str2,"> not found"
-            CALL abort
-         ENDIF
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#else
-         ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,
-     &          tsoilold(1,1,isoil))
-#endif
-         IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &            "Failed reading <","Tg"//str2,">"
-            CALL abort
-         ENDIF
-c
-       enddo ! of do isoil=1,nsoilold
-      
-      ! reset 'start' and 'count' to "3D" behaviour
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,nsoilold,1/)
-      
-      else
-       write(*,*) "lect_start_archive: loading tsoil "
-       ierr=NF_INQ_VARID(nid,"tsoil",nvarid)
-       if (ierr.ne.NF_NOERR) then
-        write(*,*)"lect_start_archive: Cannot find <tsoil>"
-	call abort
-       else
-#ifdef NC_DOUBLE
-      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,tsoilold)
-#else
-      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,tsoilold)
-#endif
-       endif ! of if (ierr.ne.NF_NOERR)
-       
-      endif ! of if (olddepthdef)
-
-!
-! Read soil thermal inertias
-!
-!      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
-!       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
-!       if (ierr.ne.NF_NOERR) then
-!        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
-!	call abort
-!       else
-!#ifdef NC_DOUBLE
-!      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
-!#else
-!      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
-!#endif
-!       endif ! of if (ierr.ne.NF_NOERR)
-!      endif
-
-c-----------------------------------------------------------------------
-c 5.3	Lecture des champs 3D (t,u,v, q2atm,q)
-c-----------------------------------------------------------------------
-
-      start=(/1,1,1,memo/)
-      count=(/imold+1,jmold+1,lmold,1/)
-
-c
-      ierr = NF_INQ_VARID (nid,"temp", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <temp> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, count, told)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid, start, count, told)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <temp>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"u", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <u> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,uold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,uold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <u>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"v", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <v> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,vold)
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,vold)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <v>"
-         CALL abort
-      ENDIF
-c
-      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: <q2atm> is missing"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,q2old(1,1,2))
-#else
-      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,q2old(1,1,2))
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "lect_start_archive: Failed loading <q2atm>"
-         CALL abort
-      ENDIF
-c
-
-c tracers: the 2 last ones are kept the 2 last one. 
-c the others keep their rank. ! No longer true.
-c -------------------------------------------
-! Tracers:
-      qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0
-
-      DO iq=1,nqtot
-        IF (oldtracernames) THEN
-          txt=" "
-          write(txt,'(a1,i2.2)')'q',iq
-        ELSE
-          txt=tname(iq)
-        ENDIF
-        write(*,*)"lect_start_archive: loading tracer ",trim(txt)
-        ierr = NF_INQ_VARID (nid,txt,nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &              " Tracer <",trim(txt),"> not found"
-          print*, "which (constant) value should it be initialized to?"
-          read(*,*) tmpval
-          qold(1:imold+1,1:jmold+1,1:lmold,iq)=tmpval
-        ELSE ! tracer exists in file, load it
-#ifdef NC_DOUBLE
-         ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,qold(1,1,1,iq))
-#else
-         ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,qold(1,1,1,iq))
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            PRINT*, "lect_start_archive: ",
-     &             "  Failed loading <",trim(txt),">"
-            stop
-          ENDIF
-        ENDIF
-
-      ENDDO ! of DO iq=1,nqtot
-
-
-c Chemin pour trouver les donnees de surface (albedo, relief, th.inertia...)
-c -------------------------------------------------------------------------
-
-!      datapath = '/users/forget/gcm/data_mars_gcm'
-
-
-!=======================================================================
-! 6. Interpolation from old grid to new grid
-!=======================================================================
-
-c=======================================================================
-c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
-c=======================================================================
-c  Interpolation horizontale puis passage dans la grille physique pour 
-c  les variables physique 
-c  Interpolation verticale puis horizontale pour chaque variable 3D
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c 6.1	Variable 2d :
-c-----------------------------------------------------------------------
-c Relief 
-      call interp_horiz (phisold,phisold_newgrid,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c Glace CO2
-      call interp_horiz (co2iceold,co2ices,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c Temperature de surface
-      call interp_horiz (tsurfold,tsurfs,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tsurfs,tsurf)
-c     write(44,*) 'tsurf', tsurf
-
-c Temperature du sous-sol
-!      call interp_horiz(tsoilold,tsoils,
-!     &                  imold,jmold,iim,jjm,nsoilmx,
-!     &                   rlonuold,rlatvold,rlonu,rlatv)
-!      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoils,tsoil)
-c     write(45,*) 'tsoil',tsoil
-
-c Emissivite de la surface
-      call interp_horiz (emisold,emiss,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,emiss,emis)
-
-c Dust conversion factor
-      call interp_horiz (tauscalingold,tauscalings,imold,jmold,iim,jjm,
-     &                   1,rlonuold,rlatvold,rlonu,rlatv)
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,tauscalings,tauscaling)
-c     write(46,*) 'emis',emis
-c-----------------------------------------------------------------------
-c 6.1.2	Traitement special de la pression au sol :
-c-----------------------------------------------------------------------
-
-c  Extrapolation la pression dans la nouvelle grille
-      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-c-----------------------------------------------------------------------
-c	On assure la conservation de la masse de l'atmosphere + calottes
-c-----------------------------------------------------------------------
-
-      ptotal =  0.
-      co2icetotal = 0.
-      DO j=1,jjp1
-         DO i=1,iim
-            ptotal=ptotal+ps(i,j)*aire(i,j)/g
-            co2icetotal = co2icetotal + co2iceS(i,j)*aire(i,j)
-         END DO
-      END DO
-
-      write(*,*)
-      write(*,*)'Old grid: mass of the atmosphere :',ptotalold
-      write(*,*)'New grid: mass of the atmosphere :',ptotal
-      write (*,*) 'Ratio new atm / old atm =', ptotal/ptotalold 
-      write(*,*)
-      write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold
-      write(*,*)'New grid: mass of CO2 ice:',co2icetotal
-      if (co2icetotalold.ne.0.) then
-       write(*,*)'Ratio new ice / old ice =',co2icetotal/co2icetotalold
-      endif
-      write(*,*)
-
-
-      DO j=1,jjp1
-         DO i=1,iip1
-            ps(i,j)=ps(i,j) * ptotalold/ptotal
-         END DO
-      END DO
-
-      if ( co2icetotalold.gt.0.) then 
-         DO j=1,jjp1
-            DO i=1,iip1
-               co2iceS(i,j)=co2iceS(i,j) * co2icetotalold/co2icetotal
-            END DO
-         END DO
-      end if
-
-c-----------------------------------------------------------------------
-c 6.2 Subterranean 3d variables:
-c-----------------------------------------------------------------------
-
-c-----------------------------------------------------------------------
-c 6.2.1 Thermal Inertia
-c       Note: recall that inertiedat is a common in "comsoil.h"
-c-----------------------------------------------------------------------
-
-      ! depth-wise interpolation, if required
-      if (depthinterpol.and.(.not.olddepthdef)) then
-        allocate(oldval(nsoilold))
-	allocate(newval(nsoilmx))
-        write(*,*)'lect_start_archive: WARNING: vertical interpolation o
-     &f soil thermal inertia; might be wiser to reset it.'
-        write(*,*)
-       
-        do i=1,imold+1
-         do j=1,jmold+1
-	   !copy old values
-	   oldval(1:nsoilold)=inertiedatold(i,j,1:nsoilold)
-	   !interpolate
-	   call interp_line(mlayerold,oldval,nsoilold,
-     &                     mlayer,newval,nsoilmx)
-           !copy interpolated values
-           inertiedatoldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-        enddo
-        ! cleanup
-	deallocate(oldval)
-	deallocate(newval)
-      endif !of if (depthinterpol)
-
-      if (therminertia_3D) then
-        ! We have inertiedatold
-       if((imold.ne.iim).or.(jmold.ne.jjm)) then
-       write(*,*)'lect_start_archive: WARNING: horizontal interpolation 
-     &of thermal inertia; might be better to reset it.'
-       write(*,*)
-       endif
-       
-        ! Do horizontal interpolation
-	if (depthinterpol) then
-	  call interp_horiz(inertiedatoldnew,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-	else
-          call interp_horiz(inertiedatold,inertiedatS,
-     &                  imold,jmold,iim,jjm,nsoilold,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-        endif ! of if (depthinterpol)
-
-      else ! no 3D thermal inertia data
-       write(*,*)'lect_start_archive: using reference surface inertia'
-        ! Use surface inertia (and extend it to all depths)
-        do i=1,nsoilmx
-         inertiedatS(1:iip1,1:jjp1,i)=surfith(1:iip1,1:jjp1)
-        enddo
-	! Build an old resolution surface thermal inertia
-	! (will be needed for tsoil interpolation)
-	call interp_horiz(surfith,surfithold,
-     &                    iim,jjm,imold,jmold,1,
-     &                    rlonu,rlatv,rlonuold,rlatvold)
-      endif
-
-
-      ! Reshape inertiedatS to scalar grid as inertiedat
-      call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,
-     &                  inertiedatS,inertiedat)
-      
-c-----------------------------------------------------------------------
-c 6.2.2 Soil temperature
-c-----------------------------------------------------------------------
-!      write(*,*) 'Soil'
-      ! Recast temperatures along soil depth, if necessary
-      if (olddepthdef) then
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        do i=1,imold+1
-	 do j=1,jmold+1
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	   ! build vertical coordinate
-	   oldgrid(1)=0. ! ground
-	   oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)*
-     &                (surfithold(i,j)/1.e6)
-          ! Note; at this stage, we impose volcapa=1.e6 above
-	  ! since volcapa isn't set in old soil definitions
-
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-
-      else
-       if (depthinterpol) then ! if vertical interpolation is required
-        allocate(oldgrid(nsoilold+1))
-        allocate(oldval(nsoilold+1))
-	allocate(newval(nsoilmx))
-        ! build vertical coordinate
-	oldgrid(1)=0. ! ground
-	oldgrid(2:nsoilold+1)=mlayerold(1:nsoilold)
-        do i=1,imold+1
-	 do j=1,jmold+1
-	   ! copy values
-	   oldval(1)=tsurfold(i,j)
-	   oldval(2:nsoilold+1)=tsoilold(i,j,1:nsoilold)
-	  ! interpolate
-	  call interp_line(oldgrid,oldval,nsoilold+1,
-     &                     mlayer,newval,nsoilmx)
-	 ! copy result in tsoilold
-	 tsoiloldnew(i,j,1:nsoilmx)=newval(1:nsoilmx)
-	 enddo
-	enddo
-!	write(*,*)'tsoiloldnew(1,1,1):',tsoiloldnew(1,1,1)
-        ! cleanup
-	deallocate(oldgrid)
-	deallocate(oldval)
-	deallocate(newval)
-       
-       else
-        tsoiloldnew(:,:,:)=tsoilold(:,:,:)
-       endif ! of if (depthinterpol)
-      endif ! of if (olddepthdef)
-
-      ! Do the horizontal interpolation
-       call interp_horiz(tsoiloldnew,tsoilS,
-     &                  imold,jmold,iim,jjm,nsoilmx,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-
-      ! Reshape tsoilS to scalar grid as tsoil
-       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
-
-
-
-c-----------------------------------------------------------------------
-c 6.3 Variable 3d :
-c-----------------------------------------------------------------------
-      
-c temperatures atmospheriques
-      write (*,*) 'lect_start_archive: told ', told (1,jmold+1,1)  ! INFO
-      call interp_vert
-     &    (told,var,lmold,llm,apsold,bpsold,aps,bps,
-     &     psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,jmold+1,1)  ! INFO
-      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
-
-c q2 : pbl wind variance
-      write (*,*) 'lect_start_archive: q2old ', q2old (1,2,1)  ! INFO
-      call interp_vert (q2old,varp1,lmold+1,llm+1,
-     &     apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: varp1 ', varp1 (1,2,1)  ! INFO
-      call interp_horiz(varp1,q2s,imold,jmold,iim,jjm,llm+1,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: q2s ', q2s (1,2,1)  ! INFO
-      call gr_dyn_fi (llm+1,iim+1,jjm+1,ngrid,q2s,q2)
-      write (*,*) 'lect_start_archive: q2 ', q2 (1,2)  ! INFO
-c     write(47,*) 'q2',q2
-
-c calcul des champ de vent; passage en vent covariant
-      write (*,*) 'lect_start_archive: uold ', uold (1,2,1)  ! INFO
-      call interp_vert
-     & (uold,var,lmold,llm,apsold,bpsold,aps,bps,
-     &  psold,(imold+1)*(jmold+1))
-      write (*,*) 'lect_start_archive: var ', var (1,2,1)  ! INFO
-      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      write (*,*) 'lect_start_archive: us ', us (1,2,1)   ! INFO
-
-      call interp_vert
-     & (vold,var,lmold,llm,
-     &  apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
-     &                   rlonuold,rlatvold,rlonu,rlatv)
-      call scal_wind(us,vs,unat,vnat)
-      write (*,*) 'lect_start_archive: unat ', unat (1,1,1)    ! INFO
-      do l=1,llm
-        do j = 1, jjp1
-          do i=1,iip1
-            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
-c           ucov( i,j,l ) = 0
-          end do
-        end do
-      end do 
-      write (*,*) 'lect_start_archive: ucov ', ucov (1,1,1)  ! INFO
-c     write(48,*) 'ucov',ucov
-      do l=1,llm
-        do j = 1, jjm
-          do i=1,iim
-            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
-c           vcov( i,j,l ) = 0
-          end do
-          vcov( iip1,j,l ) = vcov( 1,j,l )
-        end do
-      end do
-c     write(49,*) 'ucov',vcov
-
-c traceurs surface
-      do iq = 1, nqtot
-            call interp_horiz(qsurfold(1,1,iq) ,qsurfs(1,1,iq),
-     &                  imold,jmold,iim,jjm,1,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-
-      call gr_dyn_fi (nqtot,iim+1,jjm+1,ngrid,qsurfs,qsurf)
-
-c traceurs 3D
-      do  iq = 1, nqtot
-            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
-     &        apsold,bpsold,aps,bps,psold,(imold+1)*(jmold+1))
-            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
-     &                  rlonuold,rlatvold,rlonu,rlatv)
-      enddo
-cccccccccccccccccccccccccccccc      
-c  make sure that sum of q = 1      
-c dominent species is = 1 - sum(all other species)      
-cccccccccccccccccccccccccccccc      
-c      iqmax=1
-c      
-c      if (nqold.gt.10) then
-c       do l=1,llm
-c        do j=1,jjp1
-c          do i=1,iip1
-c           do iq=1,nqold
-c            if (q(i,j,l,iq).gt.q(i,j,l,iqmax)) then
-c              iqmax=iq
-c            endif
-c           enddo
-c           q(i,j,l,iqmax)=1.
-c           qtot(i,j,l)=0
-c           do iq=1,nqold
-c            if (iq.ne.iqmax) then        
-c              q(i,j,l,iqmax)=q(i,j,l,iqmax)-q(i,j,l,iq)        
-c            endif
-c           enddo !iq
-c           do iq=1,nqold
-c            qtot(i,j,l)=qtot(i,j,l)+q(i,j,l,iq)
-c            if (i.eq.1.and.j.eq.1.and.l.Eq.1) write(*,*)' qtot(i,j,l)',
-c     $    qtot(i,j,l)
-c           enddo !iq
-c          enddo !i   
-c         enddo !j   
-c       enddo !l  
-c      endif
-ccccccccccccccccccccccccccccccc
-
-c     Periodicite :
-      do  iq = 1, nqtot
-         do l=1, llm
-            do j = 1, jjp1
-               q(iip1,j,l,iq) = q(1,j,l,iq)
-            end do
-         end do
-      enddo
-      
-      call gr_dyn_fi (1,iim+1,jjm+1,ngrid,co2ices,co2ice)
-
-c-----------------------------------------------------------------------
-c   Initialisation  h:	(passage de t -> h)
-c-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO j=1,jjp1
-            DO i=1,iim
-               h(i,j,l) = t(i,j,l)*((ps(i,j)/preff)**kappa)
-            END DO
-            h(iip1,j,l) =  h(1,j,l)
-         END DO
-      END DO
-
-
-c***********************************************************************
-c***********************************************************************
-c     Fin subroutine lecture ini
-c***********************************************************************
-c***********************************************************************
-
-      deallocate(timelist)
-      deallocate(rlonuold, rlatvold)
-      deallocate(rlonvold, rlatuold)
-      deallocate(apsold,bpsold)
-      deallocate(uold)
-      deallocate(vold)
-      deallocate(told)
-      deallocate(psold)
-      deallocate(phisold)
-      deallocate(qold)
-      deallocate(co2iceold)
-      deallocate(tsurfold)
-      deallocate(emisold)
-      deallocate(q2old)
-      deallocate(tsoilold)
-      deallocate(tsoiloldnew)
-      deallocate(inertiedatold)
-      deallocate(inertiedatoldnew)
-      deallocate(surfithold)
-      deallocate(mlayerold)
-      deallocate(qsurfold)
-      deallocate(tauscalingold)
-      deallocate(var,varp1)
-
-!      write(*,*)'lect_start_archive: END'
-      return
-      end
Index: trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_grid_phy_lmdz.F90	(revision 1399)
+++ 	(revision )
@@ -1,453 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_grid_phy_lmdz
-
-  PUBLIC
-  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
-             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
-
-  INTEGER,SAVE :: nbp_lon  ! == iim
-  INTEGER,SAVE :: nbp_lat  ! == jjmp1
-  INTEGER,SAVE :: nbp_lev  ! == llm
-  INTEGER,SAVE :: klon_glo
-
-  INTERFACE grid1dTo2d_glo
-    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
-                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
-		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
-   END INTERFACE 
-
-   INTERFACE grid2dTo1d_glo
-    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
-                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
-		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
-   END INTERFACE 
- 
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE init_grid_phy_lmdz(iim,jjp1,llm)
-  IMPLICIT NONE
-  INTEGER, INTENT(in) :: iim
-  INTEGER, INTENT(in) :: jjp1
-  INTEGER, INTENT(in) :: llm
-  
-    nbp_lon=iim
-    nbp_lat=jjp1
-    nbp_lev=llm
-    klon_glo=(iim*jjp1)-2*(iim-1)
-  
-  ! Ehouarn: handle 1D case:
-  if ((iim.eq.1).and.(jjp1.eq.2)) then
-    nbp_lat=1
-    klon_glo=1
-  endif
-  
-  END SUBROUTINE init_grid_phy_lmdz
-  
-  
-  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_i
-  
-
-  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_i1
-
-  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_i2
-  
-  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_i3
-
-
-  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_r
-  
-
-  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_r1
-
-  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_r2
-  
-  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_glo_l
-  
-
-  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_glo_l1
-
-  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_glo_l2
-  
-  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_glo_l3  
-  
-    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_i
-  
-
-  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_i1
-
-  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_i2
-  
-  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_r
-  
-
-  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_r1
-
-  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_r2
-  
-  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_r3
-
-
-
-  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_glo_l
-  
-
-  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_glo_l1
-
-  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_glo_l2
-  
-  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_glo_l3
-
-!---------------------------------------------------------------- 
-!  fonctions generiques (privees)
-!---------------------------------------------------------------- 
-  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_igen   
-
-
-  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-   
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_rgen   
-
-  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    Offset=nbp_lon
-        
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=1,nbp_lon
-       VarOut(ij,i)=VarIn(1,i)
-      ENDDO
-    ENDDO
-    
-    
-    DO i=1,dimsize
-      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
-       VarOut(ij,i)=VarIn(klon_glo,i)
-      ENDDO
-    ENDDO
-
-  END SUBROUTINE grid1dTo2d_glo_lgen     
-  
-  
-  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_igen   
-  
-  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_rgen 
-    
-  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_glo
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    DO i=1,dimsize
-      VarOut(1,i)=VarIn(1,i)
-    ENDDO
-    
-  END SUBROUTINE grid2dTo1d_glo_lgen   
-
-END MODULE mod_grid_phy_lmdz
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_data.F90	(revision 1399)
+++ 	(revision )
@@ -1,211 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_mpi_data
-  USE mod_const_mpi, only: MPI_REAL_LMDZ, COMM_LMDZ
-  
-  INTEGER,SAVE :: ii_begin
-  INTEGER,SAVE :: ii_end
-  INTEGER,SAVE :: jj_begin
-  INTEGER,SAVE :: jj_end
-  INTEGER,SAVE :: jj_nb
-  INTEGER,SAVE :: ij_begin
-  INTEGER,SAVE :: ij_end
-  INTEGER,SAVE :: ij_nb
-  INTEGER,SAVE :: klon_mpi_begin
-  INTEGER,SAVE :: klon_mpi_end
-  INTEGER,SAVE :: klon_mpi
-  
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
-
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
-
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
-
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
-
-  
-  INTEGER,SAVE :: mpi_rank
-  INTEGER,SAVE :: mpi_size
-  INTEGER,SAVE :: mpi_root
-  LOGICAL,SAVE :: is_mpi_root
-  LOGICAL,SAVE :: is_using_mpi
-  
-  
-  LOGICAL,SAVE :: is_north_pole
-  LOGICAL,SAVE :: is_south_pole
-  INTEGER,SAVE :: COMM_LMDZ_PHY
-
-CONTAINS
-  
-  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
-  USE mod_const_mpi, ONLY : COMM_LMDZ
-  IMPLICIT NONE
-    INTEGER,INTENT(in) :: iim
-    INTEGER,INTENT(in) :: jjp1
-    INTEGER,INTENT(in) :: nb_proc
-    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
-    
-    INTEGER :: ierr
-    INTEGER :: klon_glo
-    INTEGER :: i
-    
-#ifdef CPP_MPI
-    is_using_mpi=.TRUE.
-#else
-    is_using_mpi=.FALSE.
-#endif
-    
-    if (iim.eq.1) then
-       klon_glo=1
-    else
-       klon_glo=iim*(jjp1-2)+2
-    endif
-    
-    COMM_LMDZ_PHY=COMM_LMDZ
-
-    IF (is_using_mpi) THEN    
-#ifdef CPP_MPI
-      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
-      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
-#endif
-    ELSE
-      mpi_size=1
-      mpi_rank=0
-    ENDIF
-    
-    IF (mpi_rank == 0) THEN
-      mpi_root = 0
-      is_mpi_root = .true.
-    ENDIF
-    
-    IF (mpi_rank == 0) THEN 
-      is_north_pole = .TRUE.
-    ELSE
-      is_north_pole = .FALSE.
-    ENDIF
-    
-    IF (mpi_rank == mpi_size-1) THEN
-      is_south_pole = .TRUE.
-    ELSE
-      is_south_pole = .FALSE.
-    ENDIF
-    
-    ALLOCATE(jj_para_nb(0:mpi_size-1))
-    ALLOCATE(jj_para_begin(0:mpi_size-1))
-    ALLOCATE(jj_para_end(0:mpi_size-1))
-    
-    ALLOCATE(ij_para_nb(0:mpi_size-1))
-    ALLOCATE(ij_para_begin(0:mpi_size-1))
-    ALLOCATE(ij_para_end(0:mpi_size-1))
-    
-    ALLOCATE(ii_para_begin(0:mpi_size-1))
-    ALLOCATE(ii_para_end(0:mpi_size-1))
-
-    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
-    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
-    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
-  
-      
-    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
-
-    DO i=0,mpi_size-1
-      IF (i==0) THEN 
-        klon_mpi_para_begin(i)=1
-      ELSE 
-        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
-      ENDIF
-        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
-    ENDDO
-
-
-    DO i=0,mpi_size-1
-      
-      IF (i==0) THEN
-        ij_para_begin(i) = 1
-      ELSE
-        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
-      ENDIF
-
-      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
-      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
-
-      
-      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
-      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
-      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
-
-      ! Ehouarn: handle 1D case:
-      if (klon_glo.eq.1) then
-        klon_mpi_para_end(i) = 1
-        klon_mpi_para_nb(i) = 1
-        ij_para_end(i) = 1
-        jj_para_end(i) = 1
-        ii_para_end(i) = 1
-      endif
-
-      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
-      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
-         
-    ENDDO
-  
-    ii_begin = ii_para_begin(mpi_rank)
-    ii_end   = ii_para_end(mpi_rank)
-    jj_begin = jj_para_begin(mpi_rank)
-    jj_end   = jj_para_end(mpi_rank)
-    jj_nb    = jj_para_nb(mpi_rank)
-    ij_begin = ij_para_begin(mpi_rank)
-    ij_end   = ij_para_end(mpi_rank)
-    ij_nb    = ij_para_nb(mpi_rank)
-    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
-    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
-    klon_mpi       = klon_mpi_para_nb(mpi_rank)
-   
-    CALL Print_module_data
-    
-  END SUBROUTINE Init_phys_lmdz_mpi_data
-
-  SUBROUTINE print_module_data
-  IMPLICIT NONE
-!  INCLUDE "iniprint.h" 
-  
-    WRITE(*,*) 'ii_begin =', ii_begin
-    WRITE(*,*) 'ii_end =', ii_end
-    WRITE(*,*) 'jj_begin =',jj_begin
-    WRITE(*,*) 'jj_end =', jj_end
-    WRITE(*,*) 'jj_nb =', jj_nb
-    WRITE(*,*) 'ij_begin =', ij_begin
-    WRITE(*,*) 'ij_end =', ij_end
-    WRITE(*,*) 'ij_nb =', ij_nb
-    WRITE(*,*) 'klon_mpi_begin =', klon_mpi_begin
-    WRITE(*,*) 'klon_mpi_end =', klon_mpi_end
-    WRITE(*,*) 'klon_mpi =', klon_mpi
-    WRITE(*,*) 'jj_para_nb =', jj_para_nb
-    WRITE(*,*) 'jj_para_begin =', jj_para_begin
-    WRITE(*,*) 'jj_para_end =', jj_para_end
-    WRITE(*,*) 'ii_para_begin =', ii_para_begin
-    WRITE(*,*) 'ii_para_end =', ii_para_end
-    WRITE(*,*) 'ij_para_nb =', ij_para_nb
-    WRITE(*,*) 'ij_para_begin =', ij_para_begin
-    WRITE(*,*) 'ij_para_end =', ij_para_end
-    WRITE(*,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
-    WRITE(*,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
-    WRITE(*,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
-    WRITE(*,*) 'mpi_rank =', mpi_rank
-    WRITE(*,*) 'mpi_size =', mpi_size
-    WRITE(*,*) 'mpi_root =', mpi_root
-    WRITE(*,*) 'is_mpi_root =', is_mpi_root
-    WRITE(*,*) 'is_north_pole =', is_north_pole
-    WRITE(*,*) 'is_south_pole =', is_south_pole
-    WRITE(*,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
-  
-  END SUBROUTINE print_module_data
-  
-END MODULE mod_phys_lmdz_mpi_data
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_mpi_transfert.F90	(revision 1399)
+++ 	(revision )
@@ -1,1906 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_mpi_transfert
-
-
-  INTERFACE bcast_mpi
-    MODULE PROCEDURE bcast_mpi_c,                                                     &
-                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
-                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
-		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
-  END INTERFACE
-
-  INTERFACE scatter_mpi
-    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
-                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
-		     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
-  END INTERFACE
-
-  
-  INTERFACE gather_mpi
-    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
-                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
-		     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
-  END INTERFACE
-  
-  INTERFACE scatter2D_mpi
-    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
-                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
-		     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
-  END INTERFACE
-
-  INTERFACE gather2D_mpi
-    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
-                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
-		     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
-  END INTERFACE 
-  
-  INTERFACE reduce_sum_mpi
-    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
-                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
-  END INTERFACE 
-
- INTERFACE grid1dTo2d_mpi
-    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
-                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
-		     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
- END INTERFACE 
-
- INTERFACE grid2dTo1d_mpi
-    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
-                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
-		     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
- END INTERFACE 
-    
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactère -- !!
-
-  SUBROUTINE bcast_mpi_c(var1)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
-   
-    CALL bcast_mpi_cgen(Var1,len(Var1))
-
-  END SUBROUTINE bcast_mpi_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_mpi_i(var)
-  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-    
-    INTEGER               :: var_tmp(1)
-    
-    IF (is_mpi_root) var_tmp(1)=var
-    CALL bcast_mpi_igen(Var_tmp,1)
-    var=var_tmp(1)
-    
-  END SUBROUTINE bcast_mpi_i
-
-  SUBROUTINE bcast_mpi_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-
-    CALL bcast_mpi_igen(Var,size(Var))
-    
-  END SUBROUTINE bcast_mpi_i1
-
-  SUBROUTINE bcast_mpi_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-  
-  END SUBROUTINE bcast_mpi_i2
-
-  SUBROUTINE bcast_mpi_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i3
-
-  SUBROUTINE bcast_mpi_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_igen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_i4
-
-
-!! -- Les reels -- !!
-
-  SUBROUTINE bcast_mpi_r(var)
-  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-    REAL               :: var_tmp(1)
-    
-    IF (is_mpi_root) var_tmp(1)=var
-    CALL bcast_mpi_rgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_r
-
-  SUBROUTINE bcast_mpi_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r1
-
-  SUBROUTINE bcast_mpi_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r2
-
-  SUBROUTINE bcast_mpi_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r3
-
-  SUBROUTINE bcast_mpi_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_rgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_r4
-  
-!! -- Les booleans -- !!
-
-  SUBROUTINE bcast_mpi_l(var)
-  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-    LOGICAL               :: var_tmp(1)
-    
-    IF (is_mpi_root) var_tmp(1)=var
-    CALL bcast_mpi_lgen(Var_tmp,1)
-    var=var_tmp(1)   
-
-  END SUBROUTINE bcast_mpi_l
-
-  SUBROUTINE bcast_mpi_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l1
-
-  SUBROUTINE bcast_mpi_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l2
-
-  SUBROUTINE bcast_mpi_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l3
-
-  SUBROUTINE bcast_mpi_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL bcast_mpi_lgen(Var,size(Var))
-
-  END SUBROUTINE bcast_mpi_l4
-  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL scatter_mpi_igen(VarIn,Varout,1)
-    
-  END SUBROUTINE scatter_mpi_i
-
-  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
-    
-  END SUBROUTINE scatter_mpi_i1
-  
-  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
-
-  END SUBROUTINE scatter_mpi_i2
-
-  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
-  
-  END SUBROUTINE scatter_mpi_i3
-
-
-  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-      CALL scatter_mpi_rgen(VarIn,Varout,1)
-  
-  END SUBROUTINE scatter_mpi_r
-
-  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
-  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-  IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
-  
-  END SUBROUTINE scatter_mpi_r1
-  
-  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
-  
-  END SUBROUTINE scatter_mpi_r2
-
-  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
-  
-  END SUBROUTINE scatter_mpi_r3
-
-
-  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-      CALL scatter_mpi_lgen(VarIn,Varout,1)
-    
-  END SUBROUTINE scatter_mpi_l
-
-  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
-  
-  END SUBROUTINE scatter_mpi_l1
-  
-  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
-  
-  END SUBROUTINE scatter_mpi_l2
-
-  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
-  
-  END SUBROUTINE scatter_mpi_l3  
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Gather   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- 
-!!!!! --> Les entiers
-
-  SUBROUTINE gather_mpi_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-      CALL gather_mpi_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE gather_mpi_i
-  
-
-!!!!!
-
-  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
-  
-  END SUBROUTINE gather_mpi_i1
-
-!!!!!
-  
-  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
-  
-  END SUBROUTINE gather_mpi_i2
-
-!!!!!
-
-  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
-  
-  END SUBROUTINE gather_mpi_i3
-
-!!!!! --> Les reels
-
-  SUBROUTINE gather_mpi_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-      CALL gather_mpi_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE gather_mpi_r
-
-!!!!!
-
-  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
-  
-  END SUBROUTINE gather_mpi_r1
-
-!!!!!
-  
-  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
-  
-  END SUBROUTINE gather_mpi_r2
-
-!!!!!
-
-  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
-  
-  END SUBROUTINE gather_mpi_r3
-
-!!!!! --> Les booleen
-
-  SUBROUTINE gather_mpi_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-      CALL gather_mpi_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE gather_mpi_l
-
-!!!!!
-
-  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
-  
-  END SUBROUTINE gather_mpi_l1
-
-!!!!!
-  
-  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
-  
-  END SUBROUTINE gather_mpi_l2
-
-!!!!!
-
-  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
-  
-  END SUBROUTINE gather_mpi_l3
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter2D   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
-    
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_i
-
-  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_i1
-
-  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_i2
-  
-  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-    
-  END SUBROUTINE scatter2D_mpi_i3
-
-
-
-  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    REAL,DIMENSION(klon_glo) :: Var_tmp    
-    
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_R
-
-
-  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
-    
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_r1
-
-
-  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
-    
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_r2
-  
-  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
- 
-  END SUBROUTINE scatter2D_mpi_r3
-  
-  
-  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
-    
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_l
-
-
-  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-  
-  END SUBROUTINE scatter2D_mpi_l1
-
-
-  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
-  
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_mpi_l2
-  
-  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid2dTo1d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
-
-    CALL grid2dTo1d_glo(VarIn,Var_tmp)
-    CALL scatter_mpi(Var_tmp,VarOut)
- 
-  END SUBROUTINE scatter2D_mpi_l3
-  
-  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Gather2D   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_glo) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_i
-
-  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
-
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_i1
-
-  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_i2
-  
-  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
- 
-    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_i3
-
-
-
-  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_r
-
-  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
-
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_r1
-
-  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
-
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_r2
-  
-  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_r3
-
-  
-  
-  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_l
-
-  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
-
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_l1
-
-  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
-
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_l2
-  
-  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
-    USE mod_grid_phy_lmdz, only: klon_glo, grid1dTo2d_glo
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
-    
-    CALL gather_mpi(VarIn,Var_tmp)
-    CALL grid1dTo2d_glo(Var_tmp,VarOut)
-
-  END SUBROUTINE gather2D_mpi_l3
-  
-  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des reduce_sum   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN)  :: VarIn
-    INTEGER,INTENT(OUT) :: VarOut
-    INTEGER             :: VarIn_tmp(1)
-    INTEGER             :: VarOut_tmp(1)
-    
-    VarIn_tmp(1)=VarIn    
-    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
-    VarOut=VarOut_tmp(1)
-    
-  END SUBROUTINE reduce_sum_mpi_i
-
-  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_i1
-
-  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_i2
-
-  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_i3
-
-  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_i4                  
-  
-  
-  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN)  :: VarIn
-    REAL,INTENT(OUT) :: VarOut
-    REAL             :: VarIn_tmp(1)
-    REAL             :: VarOut_tmp(1)
-    
-    VarIn_tmp(1)=VarIn    
-    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
-    VarOut=VarOut_tmp(1)
-  
-  END SUBROUTINE reduce_sum_mpi_r
-
-  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
-     
-  END SUBROUTINE reduce_sum_mpi_r1
-
-  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_r2
-
-  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_r3
-
-  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
-  
-  END SUBROUTINE reduce_sum_mpi_r4 
-  
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! SUBROUTINE grid1dTo2d  !!  
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_mpi_i
-  
-
-  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_mpi_i1
-
-  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_mpi_i2
-  
-  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_mpi_i3
-
-
-  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_mpi_r
-  
-
-  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_mpi_r1
-
-  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_mpi_r2
-  
-  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_mpi_r3
-  
-  
-  
-  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid1dTo2d_mpi_l
-  
-
-  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
-  
-  END SUBROUTINE grid1dTo2d_mpi_l1
-
-  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
-  
-  END SUBROUTINE grid1dTo2d_mpi_l2
-  
-  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
-    
-    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid1dTo2d_mpi_l3
-
-
-  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_mpi_i
-  
-
-  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_mpi_i1
-
-  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_mpi_i2
-  
-  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_mpi_i3
- 
-
-
-
-  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_mpi_r
-  
-
-  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_mpi_r1
-
-  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_mpi_r2
-  
-  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_mpi_r3
-
-
-
-  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
-  
-  END SUBROUTINE grid2dTo1d_mpi_l
-  
-
-  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
-  
-  END SUBROUTINE grid2dTo1d_mpi_l1
-
-
-
-  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
-  
-  END SUBROUTINE grid2dTo1d_mpi_l2
-
-  
-  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
-  IMPLICIT NONE  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
-    
-    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
-  
-  END SUBROUTINE grid2dTo1d_mpi_l3
-
-               
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE bcast_mpi_cgen(var,nb)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    IMPLICIT NONE
-    
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) RETURN
-    
-#ifdef CPP_MPI
-    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
-#endif
-        
-  END SUBROUTINE bcast_mpi_cgen
-
-
-      
-  SUBROUTINE bcast_mpi_igen(var,nb)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    IMPLICIT NONE
-    
-    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) RETURN
-
-#ifdef CPP_MPI
-    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
-#endif
-        
-  END SUBROUTINE bcast_mpi_igen
-
-
-
-  
-  SUBROUTINE bcast_mpi_rgen(var,nb)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    IMPLICIT NONE
-    
-    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) RETURN
-
-#ifdef CPP_MPI
-    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
-#endif
-    
-  END SUBROUTINE bcast_mpi_rgen
-  
-
-
-
-  SUBROUTINE bcast_mpi_lgen(var,nb)
-    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
-    IMPLICIT NONE
-    
-    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
-    INTEGER,INTENT(IN) :: nb
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) RETURN
-
-#ifdef CPP_MPI
-    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
-    if (ierr.ne.MPI_SUCCESS) then
-      write(*,*) "bcast_mpi error: ierr=",ierr
-      stop
-    endif
-#endif
-
-  END SUBROUTINE bcast_mpi_lgen
-
-  
-
-  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-
-
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-
-    
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-        DO i=1,dimsize
-          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
-          Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-      
-#ifdef CPP_MPI 
-    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
-                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
-#endif
-
-  END SUBROUTINE scatter_mpi_igen
-
-  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-    
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-        DO i=1,dimsize
-          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
-          Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-      
-#ifdef CPP_MPI 
-    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
-                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
-
-#endif
-
-  END SUBROUTINE scatter_mpi_rgen
-
-  
-  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-    
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-        DO i=1,dimsize
-          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
-          Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-      
-#ifdef CPP_MPI
-    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
-                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
-#endif
-
-  END SUBROUTINE scatter_mpi_lgen  
-
-
-
-
-  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
-  
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-	Index=Index+nb*dimsize
-      ENDDO
-     
-    ENDIF
-    
-#ifdef CPP_MPI
-    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
-                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
-#endif
-
-		          
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        DO i=1,dimsize
-          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
-	  Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-
-  END SUBROUTINE gather_mpi_igen  
-
-  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
-  
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-	Index=Index+nb*dimsize
-      ENDDO
-    ENDIF
-    
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-
-#ifdef CPP_MPI
-    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
-                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
-#endif
-		          
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        DO i=1,dimsize
-          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
-	  Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-
-  END SUBROUTINE gather_mpi_rgen  
-
-  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
-  
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-
-    INTEGER,DIMENSION(0:mpi_size-1) :: displs
-    INTEGER,DIMENSION(0:mpi_size-1) :: counts
-    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
-    INTEGER :: nb,i,index,rank
-    INTEGER :: ierr
-    
-    IF (.not.is_using_mpi) THEN
-      VarOut(:,:)=VarIn(:,:)
-      RETURN
-    ENDIF
-
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        displs(rank)=Index-1
-        counts(rank)=nb*dimsize
-	Index=Index+nb*dimsize
-      ENDDO
-    ENDIF
-    
-
-#ifdef CPP_MPI
-    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
-                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
-#endif
-		          
-    IF (is_mpi_root) THEN
-      Index=1
-      DO rank=0,mpi_size-1
-        nb=klon_mpi_para_nb(rank)
-        DO i=1,dimsize
-          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
-	  Index=Index+nb
-        ENDDO
-      ENDDO
-    ENDIF
-
-  END SUBROUTINE gather_mpi_lgen
-  
-
-
-  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-   
-    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
-    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
-    INTEGER,INTENT(IN) :: nb
-    INTEGER :: ierr
-   
-    IF (.not.is_using_mpi) THEN
-      VarOut(:)=VarIn(:)
-      RETURN
-    ENDIF
-
-
-#ifdef CPP_MPI
-    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
-#endif
-            
-  END SUBROUTINE reduce_sum_mpi_igen
-  
-  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
-    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
-    USE mod_grid_phy_lmdz
-
-    IMPLICIT NONE
-
-#ifdef CPP_MPI
-    INCLUDE 'mpif.h'
-#endif
-    
-    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
-    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
-    INTEGER,INTENT(IN) :: nb
-    INTEGER :: ierr
- 
-    IF (.not.is_using_mpi) THEN
-      VarOut(:)=VarIn(:)
-      RETURN
-    ENDIF
-   
-#ifdef CPP_MPI
-    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
-#endif
-        
-  END SUBROUTINE reduce_sum_mpi_rgen
-
-
-
-  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    VarOut(1:nbp_lon,:)=0
-    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
-    
-    offset=ii_begin
-    IF (is_north_pole) Offset=nbp_lon
-    
-    
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-        DO ij=1,nbp_lon
-         VarOut(ij,i)=VarIn(1,i)
-	ENDDO
-      ENDDO
-    ENDIF
-    
-    IF (is_south_pole) THEN 
-      DO i=1,dimsize
-        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
-         VarOut(ij,i)=VarIn(klon_mpi,i)
-	ENDDO
-      ENDDO
-    ENDIF
-
-  END SUBROUTINE grid1dTo2d_mpi_igen   
-
-
-  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
-    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    VarOut(1:nbp_lon,:)=0
-    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
-    
-    offset=ii_begin
-    IF (is_north_pole) Offset=nbp_lon
-    
-    
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-        DO ij=1,nbp_lon
-         VarOut(ij,i)=VarIn(1,i)
-	ENDDO
-      ENDDO
-    ENDIF
-    
-    IF (is_south_pole) THEN 
-      DO i=1,dimsize
-        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
-         VarOut(ij,i)=VarIn(klon_mpi,i)
-	ENDDO
-      ENDDO
-    ENDIF
-
-   END SUBROUTINE grid1dTo2d_mpi_rgen   
-
-
-
-  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
-    INTEGER :: i,ij,Offset
-
-    
-    VarOut(1:nbp_lon,:)=.FALSE.
-    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
-    
-    offset=ii_begin
-    IF (is_north_pole) Offset=nbp_lon
-    
-    
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij+offset-1,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-    
-    
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-        DO ij=1,nbp_lon
-         VarOut(ij,i)=VarIn(1,i)
-	ENDDO
-      ENDDO
-    ENDIF
-    
-    IF (is_south_pole) THEN 
-      DO i=1,dimsize
-        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
-         VarOut(ij,i)=VarIn(klon_mpi,i)
-	ENDDO
-      ENDDO
-    ENDIF
-
-   END SUBROUTINE grid1dTo2d_mpi_lgen   
-
-  
-
-
-  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=ii_begin
-    IF (is_north_pole) offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-        VarOut(1,i)=VarIn(1,i)
-      ENDDO
-    ENDIF
-    
-    
-  END SUBROUTINE grid2dTo1d_mpi_igen   
-
-
-
-  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=ii_begin
-    IF (is_north_pole) offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-         VarOut(1,i)=VarIn(1,i)
-      ENDDO
-    ENDIF
-    
-    
-  END SUBROUTINE grid2dTo1d_mpi_rgen   
-  
-
-  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
-    USE mod_phys_lmdz_mpi_data
-    USE mod_grid_phy_lmdz
-    IMPLICIT NONE
-    
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
-    INTEGER :: i,ij,offset
-
-    offset=ii_begin
-    IF (is_north_pole) offset=nbp_lon
-
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=VarIn(ij+offset-1,i)
-      ENDDO
-    ENDDO
-
-    IF (is_north_pole) THEN 
-      DO i=1,dimsize
-        VarOut(1,i)=VarIn(1,i)
-      ENDDO
-    ENDIF
-    
-    
-  END SUBROUTINE grid2dTo1d_mpi_lgen   
-
-END MODULE mod_phys_lmdz_mpi_transfert
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_data.F90	(revision 1399)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-!$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas $
-!
-MODULE mod_phys_lmdz_omp_data
-
-  INTEGER,SAVE :: omp_size
-  INTEGER,SAVE :: omp_rank
-  LOGICAL,SAVE :: is_omp_root
-  LOGICAL,SAVE :: is_using_omp
-  
-  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
-  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
-  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
-  
-  INTEGER,SAVE :: klon_omp
-  INTEGER,SAVE :: klon_omp_begin
-  INTEGER,SAVE :: klon_omp_end
-!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
-
-CONTAINS
-  
-  SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi)
-    USE dimphy
-    IMPLICIT NONE
-    INTEGER, INTENT(in) :: klon_mpi
-
-    INTEGER :: i
-
-    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
-    CHARACTER (LEN=80) :: abort_message
-
-
-#ifdef CPP_OMP    
-    INTEGER :: OMP_GET_NUM_THREADS
-    EXTERNAL OMP_GET_NUM_THREADS
-    INTEGER :: OMP_GET_THREAD_NUM
-    EXTERNAL OMP_GET_THREAD_NUM
-#endif  
-
-#ifdef CPP_OMP
-!$OMP MASTER
-        is_using_omp=.TRUE.
-        omp_size=OMP_GET_NUM_THREADS()
-!$OMP END MASTER
-        omp_rank=OMP_GET_THREAD_NUM()    
-#else    
-    is_using_omp=.FALSE.
-    omp_size=1
-    omp_rank=0
-#endif
-
-   is_omp_root=.FALSE.
-!$OMP MASTER
-   IF (omp_rank==0) THEN
-     is_omp_root=.TRUE.
-   ELSE
-     abort_message = 'ANORMAL : OMP_MASTER /= 0'
-     CALL abort_gcm (modname,abort_message,1)
-   ENDIF
-!$OMP END MASTER
-
-
-!$OMP MASTER 
-    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
-    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
-    ALLOCATE(klon_omp_para_end(0:omp_size-1))
-    
-    DO i=0,omp_size-1
-      klon_omp_para_nb(i)=klon_mpi/omp_size
-      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
-    ENDDO
-    
-    klon_omp_para_begin(0) = 1
-    klon_omp_para_end(0) = klon_omp_para_nb(0)
-    
-    DO i=1,omp_size-1
-      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
-      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
-    ENDDO
-!$OMP END MASTER
-!$OMP BARRIER
-   
-    klon_omp=klon_omp_para_nb(omp_rank)
-    klon_omp_begin=klon_omp_para_begin(omp_rank)
-    klon_omp_end=klon_omp_para_end(omp_rank)
-    
-    CALL Print_module_data
-    
-  END SUBROUTINE Init_phys_lmdz_omp_data
-
-  SUBROUTINE Print_module_data
-  IMPLICIT NONE
-!  INCLUDE "iniprint.h"
-
-!$OMP CRITICAL  
-  WRITE(*,*)'--------> TASK ',omp_rank
-  WRITE(*,*)'omp_size =',omp_size
-  WRITE(*,*)'omp_rank =',omp_rank
-  WRITE(*,*)'is_omp_root =',is_omp_root
-  WRITE(*,*)'klon_omp_para_nb =',klon_omp_para_nb
-  WRITE(*,*)'klon_omp_para_begin =',klon_omp_para_begin
-  WRITE(*,*)'klon_omp_para_end =',klon_omp_para_end    
-  WRITE(*,*)'klon_omp =',klon_omp
-  WRITE(*,*)'klon_omp_begin =',klon_omp_begin
-  WRITE(*,*)'klon_omp_end =',klon_omp_end    
-!$OMP END CRITICAL
-
-  END SUBROUTINE Print_module_data
-END MODULE mod_phys_lmdz_omp_data
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_omp_transfert.F90	(revision 1399)
+++ 	(revision )
@@ -1,1057 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_omp_transfert
-
-  PRIVATE
-  
-  INTEGER,PARAMETER :: grow_factor=1.5
-  INTEGER,PARAMETER :: size_min=1024
-  
-  CHARACTER(LEN=size_min),SAVE            :: buffer_c
-!  INTEGER,SAVE                            :: size_c=0
-  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
-  INTEGER,SAVE                            :: size_i=0
-  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
-  INTEGER,SAVE                            :: size_r=0
-  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
-  INTEGER,SAVE                            :: size_l=0
-
-
-  
-  
-  INTERFACE bcast_omp
-    MODULE PROCEDURE bcast_omp_c,                                                     &
-                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
-                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
-		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
-  END INTERFACE
-
-  INTERFACE scatter_omp
-    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
-                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
-		     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
-  END INTERFACE
-
-  
-  INTERFACE gather_omp
-    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
-                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
-		     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
-  END INTERFACE
-  
-  
-  INTERFACE reduce_sum_omp
-    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
-                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
-  END INTERFACE 
-
-
-  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
-
-CONTAINS
-
-  SUBROUTINE check_buffer_i(buff_size)
-  IMPLICIT NONE
-  INTEGER :: buff_size
-
-!$OMP BARRIER
-!$OMP MASTER
-    IF (buff_size>size_i) THEN
-      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
-      size_i=MAX(size_min,INT(grow_factor*buff_size))
-      ALLOCATE(buffer_i(size_i))
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-  
-  END SUBROUTINE check_buffer_i
-  
-  SUBROUTINE check_buffer_r(buff_size)
-  IMPLICIT NONE
-  INTEGER :: buff_size
-
-!$OMP BARRIER
-!$OMP MASTER
-    IF (buff_size>size_r) THEN
-      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
-      size_r=MAX(size_min,INT(grow_factor*buff_size))
-      ALLOCATE(buffer_r(size_r))
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-  
-  END SUBROUTINE check_buffer_r
-  
-  SUBROUTINE check_buffer_l(buff_size)
-  IMPLICIT NONE
-  INTEGER :: buff_size
-
-!$OMP BARRIER
-!$OMP MASTER
-    IF (buff_size>size_l) THEN
-      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
-      size_l=MAX(size_min,INT(grow_factor*buff_size))
-      ALLOCATE(buffer_l(size_l))
-    ENDIF
-!$OMP END MASTER
-!$OMP BARRIER
-  
-  END SUBROUTINE check_buffer_l
-    
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactère -- !!
-
-  SUBROUTINE bcast_omp_c(var)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-    
-    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
-    
-  END SUBROUTINE bcast_omp_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_omp_i(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-    INTEGER :: Var_tmp(1)
-    
-    Var_tmp(1)=Var
-    CALL check_buffer_i(1)
-    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
-    Var=Var_tmp(1)
-
-  END SUBROUTINE bcast_omp_i
-
-
-  SUBROUTINE bcast_omp_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-   
-    CALL check_buffer_i(size(Var))
-    CALL bcast_omp_igen(Var,size(Var),buffer_i)
-
-  END SUBROUTINE bcast_omp_i1
-
-
-  SUBROUTINE bcast_omp_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-    CALL check_buffer_i(size(Var))
-    CALL bcast_omp_igen(Var,size(Var),buffer_i)
-
-  END SUBROUTINE bcast_omp_i2
-
-
-  SUBROUTINE bcast_omp_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-
-    CALL check_buffer_i(size(Var))
-    CALL bcast_omp_igen(Var,size(Var),buffer_i)
-
-  END SUBROUTINE bcast_omp_i3
-
-
-  SUBROUTINE bcast_omp_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL check_buffer_i(size(Var))
-    CALL bcast_omp_igen(Var,size(Var),buffer_i)
-
-  END SUBROUTINE bcast_omp_i4
-
-
-!! -- Les reels -- !!
-
-  SUBROUTINE bcast_omp_r(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-    REAL :: Var_tmp(1)
-    
-    Var_tmp(1)=Var
-    CALL check_buffer_r(1)
-    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
-    Var=Var_tmp(1)
-
-  END SUBROUTINE bcast_omp_r
-
-
-  SUBROUTINE bcast_omp_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-    CALL check_buffer_r(size(Var))
-    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
-
-  END SUBROUTINE bcast_omp_r1
-
-
-  SUBROUTINE bcast_omp_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL check_buffer_r(size(Var))
-    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
-
-  END SUBROUTINE bcast_omp_r2
-
-
-  SUBROUTINE bcast_omp_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-
-    CALL check_buffer_r(size(Var))
-    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
-
-  END SUBROUTINE bcast_omp_r3
-
-
-  SUBROUTINE bcast_omp_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL check_buffer_r(size(Var))
-    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
-
-  END SUBROUTINE bcast_omp_r4
-
-  
-!! -- Les booleans -- !!
-
-  SUBROUTINE bcast_omp_l(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-    LOGICAL :: Var_tmp(1)
-    
-    Var_tmp(1)=Var
-    CALL check_buffer_l(1)
-    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
-    Var=Var_tmp(1)
-
-  END SUBROUTINE bcast_omp_l
-
-
-  SUBROUTINE bcast_omp_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-    CALL check_buffer_l(size(Var))
-    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
-
-  END SUBROUTINE bcast_omp_l1
-
-
-  SUBROUTINE bcast_omp_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-    CALL check_buffer_l(size(Var))
-    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
-
-  END SUBROUTINE bcast_omp_l2
-
-
-  SUBROUTINE bcast_omp_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-
-    CALL check_buffer_l(size(Var))
-    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
-
-  END SUBROUTINE bcast_omp_l3
-
-
-  SUBROUTINE bcast_omp_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-    CALL check_buffer_l(size(Var))
-    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
-
-  END SUBROUTINE bcast_omp_l4
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE scatter_omp_i(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_i(size(VarIn))   
-    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
-    
-  END SUBROUTINE scatter_omp_i
-
-
-  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    CALL Check_buffer_i(size(VarIn))   
-    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
-    
-  END SUBROUTINE scatter_omp_i1
-  
-  
-  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
-
-  END SUBROUTINE scatter_omp_i2
-
-
-  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
-  
-  END SUBROUTINE scatter_omp_i3
-
-
-
-
-  SUBROUTINE scatter_omp_r(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_r(size(VarIn))   
-    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
-    
-  END SUBROUTINE scatter_omp_r
-
-
-  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
-        
-  END SUBROUTINE scatter_omp_r1
-  
-  
-  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
-
-  END SUBROUTINE scatter_omp_r2
-
-
-  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
-  
-  END SUBROUTINE scatter_omp_r3
-  
-
-
-  SUBROUTINE scatter_omp_l(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_l(size(VarIn))   
-    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
-    
-  END SUBROUTINE scatter_omp_l
-
-
-  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarIn))   
-    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
-    
-  END SUBROUTINE scatter_omp_l1
-  
-  
-  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarIn))   
-    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
-
-  END SUBROUTINE scatter_omp_l2
-
-
-  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarIn))   
-    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
-  
-  END SUBROUTINE scatter_omp_l3  
-  
-
-  SUBROUTINE gather_omp_i(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_i(size(VarOut))   
-    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
-    
-  END SUBROUTINE gather_omp_i
-
-
-  SUBROUTINE gather_omp_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarOut))   
-    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
-    
-  END SUBROUTINE gather_omp_i1
-
-
-  SUBROUTINE gather_omp_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarOut))   
-    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
-          
-  END SUBROUTINE gather_omp_i2
-  
-
-  SUBROUTINE gather_omp_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarOut))   
-    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
-    
-  END SUBROUTINE gather_omp_i3
-
-
-
-  SUBROUTINE gather_omp_r(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
-    
-  END SUBROUTINE gather_omp_r
-
-
-  SUBROUTINE gather_omp_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
-        
-  END SUBROUTINE gather_omp_r1
-
-
-  SUBROUTINE gather_omp_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
-    
-  END SUBROUTINE gather_omp_r2
-  
-
-  SUBROUTINE gather_omp_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    CALL Check_buffer_r(size(VarOut))       
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
-    
-  END SUBROUTINE gather_omp_r3
-
-
-  SUBROUTINE gather_omp_l(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    CALL Check_buffer_l(size(VarOut))   
-    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
-    
-  END SUBROUTINE gather_omp_l
-
-
-  SUBROUTINE gather_omp_l1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarOut))   
-    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
-    
-  END SUBROUTINE gather_omp_l1
-
-
-  SUBROUTINE gather_omp_l2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarOut))   
-    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
-    
-  END SUBROUTINE gather_omp_l2
-  
-
-  SUBROUTINE gather_omp_l3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    CALL Check_buffer_l(size(VarOut))   
-    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
-    
-  END SUBROUTINE gather_omp_l3
-
-
-
-
-  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN)  :: VarIn
-    INTEGER,INTENT(OUT) :: VarOut
-    INTEGER             :: VarIn_tmp(1)
-    INTEGER             :: VarOut_tmp(1)
-    
-    VarIn_tmp(1)=VarIn
-    CALL Check_buffer_i(1)   
-    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
-    VarOut=VarOut_tmp(1)
-    
-  END SUBROUTINE reduce_sum_omp_i
-
-  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-   
-  END SUBROUTINE reduce_sum_omp_i1
-  
-  
-  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_sum_omp_i2
-
-
-  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_sum_omp_i3
-
-
-  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_i(size(VarIn))   
-    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
-  
-  END SUBROUTINE reduce_sum_omp_i4
-
-
-  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN)  :: VarIn
-    REAL,INTENT(OUT) :: VarOut
-    REAL             :: VarIn_tmp(1)
-    REAL             :: VarOut_tmp(1)
-    
-    VarIn_tmp(1)=VarIn
-    CALL Check_buffer_r(1)   
-    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
-    VarOut=VarOut_tmp(1)
-  
-  END SUBROUTINE reduce_sum_omp_r
-
-  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-   
-  END SUBROUTINE reduce_sum_omp_r1
-  
-  
-  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_sum_omp_r2
-
-
-  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_sum_omp_r3
-
-
-  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
-    IMPLICIT NONE
-
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-  
-    CALL Check_buffer_r(size(VarIn))   
-    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
-  
-  END SUBROUTINE reduce_sum_omp_r4
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    LES ROUTINES GENERIQUES    !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
-  IMPLICIT NONE
-    
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
-    INTEGER,INTENT(IN) :: Nb
-    
-    INTEGER :: i
-  
-  !$OMP MASTER
-      Buff=Var
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,Nb
-      Var=Buff
-    ENDDO
-  !$OMP BARRIER      
-  
-  END SUBROUTINE bcast_omp_cgen
-
-
-      
-  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
-  IMPLICIT NONE
-    
-    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
-    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
-    INTEGER,INTENT(IN) :: Nb
-
-    INTEGER :: i
-    
-  !$OMP MASTER
-    DO i=1,Nb
-      Buff(i)=Var(i)
-    ENDDO
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,Nb
-      Var(i)=Buff(i)
-    ENDDO
-  !$OMP BARRIER        
-
-  END SUBROUTINE bcast_omp_igen
-
-
-  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
-  IMPLICIT NONE
-    
-    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
-    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
-    INTEGER,INTENT(IN) :: Nb
-
-    INTEGER :: i
-    
-  !$OMP MASTER
-    DO i=1,Nb
-      Buff(i)=Var(i)
-    ENDDO
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,Nb
-      Var(i)=Buff(i)
-    ENDDO
-  !$OMP BARRIER        
-
-  END SUBROUTINE bcast_omp_rgen
-
-  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
-  IMPLICIT NONE
-    
-    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
-    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
-    INTEGER,INTENT(IN) :: Nb
-  
-    INTEGER :: i
-    
-  !$OMP MASTER
-    DO i=1,Nb
-      Buff(i)=Var(i)
-    ENDDO
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,Nb
-      Var(i)=Buff(i)
-    ENDDO
-  !$OMP BARRIER        
-
-  END SUBROUTINE bcast_omp_lgen
-
-
-  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
-    USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-    IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
-    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        Buff(ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
- 
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
- 
-  END SUBROUTINE scatter_omp_igen
-
-
-  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
-    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        Buff(ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-
-  END SUBROUTINE scatter_omp_rgen
-
-
-  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
-    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
- !$OMP MASTER 
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        Buff(ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-
-  END SUBROUTINE scatter_omp_lgen
-
-
-
-
-
-  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-  
-  
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=Buff(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-  END SUBROUTINE gather_omp_igen
-
-
-  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-
-
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=Buff(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-  END SUBROUTINE gather_omp_rgen
-
-
-  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data, only: klon_omp, klon_omp_begin
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-
-
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=Buff(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
-  END SUBROUTINE gather_omp_lgen
-
-
-  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
-    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
-
-    INTEGER :: i
-
-  !$OMP MASTER
-    Buff(:)=0
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=Buff(i)+VarIn(i)
-    ENDDO
-  !$OMP END CRITICAL
-  !$OMP BARRIER  
-  
-  !$OMP MASTER
-    DO i=1,dimsize
-      VarOut(i)=Buff(i)
-    ENDDO
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  END SUBROUTINE reduce_sum_omp_igen
-
-  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
-    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
-
-    INTEGER :: i
-
-  !$OMP MASTER
-    Buff(:)=0
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  !$OMP CRITICAL     
-    DO i=1,dimsize
-      Buff(i)=Buff(i)+VarIn(i)
-    ENDDO
-  !$OMP END CRITICAL
-  !$OMP BARRIER  
-  
-  !$OMP MASTER
-    DO i=1,dimsize
-      VarOut(i)=Buff(i)
-    ENDDO
-  !$OMP END MASTER
-  !$OMP BARRIER
-  
-  END SUBROUTINE reduce_sum_omp_rgen
-
-END MODULE mod_phys_lmdz_omp_transfert
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_para.F90	(revision 1399)
+++ 	(revision )
@@ -1,114 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_para
-  USE mod_phys_lmdz_transfert_para
-  USE mod_phys_lmdz_mpi_data
-  USE mod_phys_lmdz_omp_data
-    
-  INTEGER,SAVE :: klon_loc
-  LOGICAL,SAVE :: is_sequential
-  LOGICAL,SAVE :: is_parallel
-  LOGICAL,SAVE :: is_master
-  
-!$OMP THREADPRIVATE(klon_loc,is_master)
-  
-CONTAINS
-
-  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
-  IMPLICIT NONE
-    INTEGER,INTENT(in) :: iim
-    INTEGER,INTENT(in) :: jjp1
-    INTEGER,INTENT(in) :: nb_proc
-    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
-
-    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
-!$OMP PARALLEL
-    CALL Init_phys_lmdz_omp_data(klon_mpi)
-    klon_loc=klon_omp
-    IF (is_mpi_root .AND. is_omp_root) THEN 
-       is_master=.TRUE.
-     ELSE
-       is_master=.FALSE.
-     ENDIF
-     CALL Test_transfert
-!$OMP END PARALLEL    
-     IF (is_using_mpi .OR. is_using_omp) THEN
-       is_sequential=.FALSE.
-       is_parallel=.TRUE.
-     ELSE
-       is_sequential=.TRUE.
-       is_parallel=.FALSE.
-     ENDIF
-      
-  END SUBROUTINE Init_phys_lmdz_para
-
-  SUBROUTINE Test_transfert
-  USE mod_grid_phy_lmdz, only: klon_glo, nbp_lev, nbp_lon, nbp_lat, &
-                               grid1dTo2d_glo, grid2dTo1d_glo
-  IMPLICIT NONE
-!    INCLUDE "iniprint.h"
- 
-    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
-    REAL :: tmp1d_glo(klon_glo,nbp_lev)
-    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
-    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
-    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
-    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
-    REAL :: CheckSum
-    
-    INTEGER :: i,l
-  
-    Test_Field1d_glo = 0.
-    Test_Field2d_glo = 0.
-    Test_Field1d_loc = 0.
-    Test_Field2d_loc = 0.
-  
-    IF (is_mpi_root) THEN
-!$OMP MASTER
-      DO l=1,nbp_lev
-        DO i=1,klon_glo
-!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
-           Test_Field1d_glo(i,l)=1
-        ENDDO
-      ENDDO
-!$OMP END MASTER  
-    ENDIF
-  
-    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
-    CALL Gather(Test_Field1d_loc,tmp1d_glo)
-  
-    IF (is_mpi_root) THEN
-!$OMP MASTER  
-      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
-      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
-!$OMP END MASTER
-    ENDIF
-    
-    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
-    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
-    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
-    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
-
-    IF (is_mpi_root) THEN
-!$OMP MASTER  
-      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
-      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
-!$OMP END MASTER
-    ENDIF
-
-    CALL bcast(Test_Field1d_glo)
-    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
-
-    IF (is_mpi_root) THEN
-!$OMP MASTER  
-      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
-      WRITE(*,*) "------> Checksum =",Checksum," MUST BE 0"
-!$OMP END MASTER
-    ENDIF
-    
-     
-   END SUBROUTINE Test_transfert
-  
-END MODULE mod_phys_lmdz_para
-    
Index: trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/mod_phys_lmdz_transfert_para.F90	(revision 1399)
+++ 	(revision )
@@ -1,1275 +1,0 @@
-!
-!$Header$
-!
-MODULE mod_phys_lmdz_transfert_para
-
-  USE mod_phys_lmdz_mpi_transfert
-  USE mod_phys_lmdz_omp_transfert 
-
-
-
-  INTERFACE bcast
-    MODULE PROCEDURE bcast_c,                                     &
-                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
-                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
-		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
-  END INTERFACE
-
-  INTERFACE scatter
-    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
-                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
-		     scatter_l,scatter_l1,scatter_l2,scatter_l3
-  END INTERFACE
-
-  
-  INTERFACE gather
-    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
-                     gather_r,gather_r1,gather_r2,gather_r3, &
-		     gather_l,gather_l1,gather_l2,gather_l3  
-  END INTERFACE
-  
-  INTERFACE scatter2D
-    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
-                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
-		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
-  END INTERFACE
-
-  INTERFACE gather2D
-    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
-                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
-		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
-  END INTERFACE 
-  
-  INTERFACE reduce_sum
-    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
-                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
-  END INTERFACE 
-
-   
-CONTAINS
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!! -- Les chaine de charactère -- !!
-
-  SUBROUTINE bcast_c(var)
-  IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(INOUT) :: Var
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_c
-
-!! -- Les entiers -- !!
-  
-  SUBROUTINE bcast_i(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i
-
-  SUBROUTINE bcast_i1(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i1
-
-
-  SUBROUTINE bcast_i2(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i2
-
-
-  SUBROUTINE bcast_i3(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i3
-
-
-  SUBROUTINE bcast_i4(var)
-  IMPLICIT NONE
-    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_i4
-
- 
-!! -- Les reels -- !!
-  
-  SUBROUTINE bcast_r(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var
-
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r
-
-  SUBROUTINE bcast_r1(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r1
-
-
-  SUBROUTINE bcast_r2(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r2
-
-
-  SUBROUTINE bcast_r3(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r3
-
-
-  SUBROUTINE bcast_r4(var)
-  IMPLICIT NONE
-    REAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_r4 
-
-
-!! -- Les booleens -- !!
-  
-  SUBROUTINE bcast_l(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l
-
-  SUBROUTINE bcast_l1(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l1
-
-
-  SUBROUTINE bcast_l2(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l2
-
-
-  SUBROUTINE bcast_l3(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l3
-
-
-  SUBROUTINE bcast_l4(var)
-  IMPLICIT NONE
-    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
-   
-!$OMP MASTER
-    CALL bcast_mpi(Var)
-!$OMP END MASTER
-    CALL bcast_omp(Var)
-    
-  END SUBROUTINE bcast_l4
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  SUBROUTINE scatter_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
-    
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_i
-
-
-  SUBROUTINE scatter_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_i1
-
-
-  SUBROUTINE scatter_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_i2
-
-
-  SUBROUTINE scatter_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,VarOut)
-    
-  END SUBROUTINE scatter_i3
-
-
-  SUBROUTINE scatter_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi) :: Var_tmp
-    
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_r
-
-
-  SUBROUTINE scatter_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_r1
-
-
-  SUBROUTINE scatter_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_r2
-
-
-  SUBROUTINE scatter_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,VarOut)
-    
-  END SUBROUTINE scatter_r3
-  
-  
-
-  SUBROUTINE scatter_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
-    
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_l
-
-
-  SUBROUTINE scatter_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_l1
-
-
-  SUBROUTINE scatter_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,Varout)
-    
-  END SUBROUTINE scatter_l2
-
-
-  SUBROUTINE scatter_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
-
-!$OMP MASTER
-      CALL scatter_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-      CALL scatter_omp(Var_tmp,VarOut)
-    
-  END SUBROUTINE scatter_l3
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Gather   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- 
-!!!!! --> Les entiers
-
-  SUBROUTINE gather_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,Varout)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_i
-
-
-  SUBROUTINE gather_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,Varout)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_i1
-
-
-  SUBROUTINE gather_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_i2
-
-
-  SUBROUTINE gather_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_i3
-
-
-!!!!! --> Les reels
-
-  SUBROUTINE gather_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    REAL, DIMENSION(klon_mpi) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_r
-
-
-  SUBROUTINE gather_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_r1
-
-
-  SUBROUTINE gather_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_r2
-
-
-  SUBROUTINE gather_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_r3
-
-
-!!!!! --> Les booleens
-
-  SUBROUTINE gather_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_l
-
-
-  SUBROUTINE gather_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_l1
-
-
-  SUBROUTINE gather_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_l2
-
-
-  SUBROUTINE gather_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-    
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE gather_l3
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter2D   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-!!!!! --> Les entiers
-
-  SUBROUTINE scatter2D_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_i
-
-
-  SUBROUTINE scatter2D_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_i1
-  
-
-  SUBROUTINE scatter2D_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_i2  
-
-
-  SUBROUTINE scatter2D_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_i3
-  
-
-!!!!! --> Les reels
-
-  SUBROUTINE scatter2D_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_r
-
-
-  SUBROUTINE scatter2D_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_r1
-  
-
-  SUBROUTINE scatter2D_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_r2  
-
-
-  SUBROUTINE scatter2D_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_r3
-    
-    
-!!!!! --> Les booleens
-
-
-  SUBROUTINE scatter2D_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_l
-
-
-  SUBROUTINE scatter2D_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_l1
-  
-
-  SUBROUTINE scatter2D_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_l2  
-
-
-  SUBROUTINE scatter2D_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
-
-!$OMP MASTER    
-    CALL scatter2D_mpi(VarIn,Var_tmp)
-!$OMP END MASTER
-    CALL scatter_omp(Var_tmp,VarOut)
-
-  END SUBROUTINE scatter2D_l3
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Gather2D   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!!!!! --> Les entiers
-
-  SUBROUTINE gather2D_i(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_i
-  
-
-  SUBROUTINE gather2D_i1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_i1
-
-  
-  SUBROUTINE gather2D_i2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_i2
-
-
-  SUBROUTINE gather2D_i3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_i3
-
-
-!!!!! --> Les reels
-
-  SUBROUTINE gather2D_r(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_mpi) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_r
-  
-
-  SUBROUTINE gather2D_r1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_r1
-
-  
-  SUBROUTINE gather2D_r2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_r2
-
-
-  SUBROUTINE gather2D_r3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_r3
-  
-
-!!!!! --> Les booleens
-
-  SUBROUTINE gather2D_l(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_l
-  
-
-  SUBROUTINE gather2D_l1(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_l1
-
-  
-  SUBROUTINE gather2D_l2(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_l2
-
-
-  SUBROUTINE gather2D_l3(VarIn, VarOut)
-    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
-    IMPLICIT NONE
-  
-    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
-    
-    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
-
-    CALL gather_omp(VarIn,Var_tmp)
-!$OMP MASTER
-    CALL gather2D_mpi(Var_tmp,VarOut)
-!$OMP END MASTER    
-
-  END SUBROUTINE gather2D_l3
-  
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des reduce_sum   --> 4D   !!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Les entiers
-
-  SUBROUTINE reduce_sum_i(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN)  :: VarIn
-    INTEGER,INTENT(OUT) :: VarOut
-    
-    INTEGER             :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_i  
-
-
-  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_i1  
-
-
-  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_i2  
-  
-
-  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_i3  
-
-
-  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_i4  
-
-
-! Les reels
-
-  SUBROUTINE reduce_sum_r(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN)  :: VarIn
-    REAL,INTENT(OUT) :: VarOut
-    
-    REAL             :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_r  
-
-
-  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
-    
-    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_r1  
-
-
-  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-    
-    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_r2  
-  
-
-  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_r3  
-
-
-  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
-    IMPLICIT NONE
-  
-    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
-    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-    
-    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
-           
-    CALL reduce_sum_omp(VarIn,Var_tmp)
-!$OMP MASTER      
-    CALL reduce_sum_mpi(Var_tmp,VarOut)
-!$OMP END MASTER
-  
-  END SUBROUTINE reduce_sum_r4  
-
-   
-END MODULE mod_phys_lmdz_transfert_para
-
Index: trunk/LMDZ.MARS/libf/phymars/newstart.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/newstart.F	(revision 1399)
+++ 	(revision )
@@ -1,1783 +1,0 @@
-C======================================================================
-      PROGRAM newstart
-c=======================================================================
-c
-c
-c   Auteur:   Christophe Hourdin/Francois Forget/Yann Wanherdrick
-c   ------
-c             Derniere modif : 12/03
-c
-c
-c   Objet:  Create or modify the initial state for the LMD Mars GCM
-c   -----           (fichiers NetCDF start et startfi)
-c
-c
-c=======================================================================
-
-      use ioipsl_getincom, only: getin 
-      use infotrac, only: iniadvtrac, nqtot, tname
-      use tracer_mod, only: noms, mmol,
-     &                      igcm_dust_number, igcm_dust_mass,
-     &                      igcm_ccn_number, igcm_ccn_mass,
-     &                      igcm_h2o_vap, igcm_h2o_ice, igcm_co2,
-     &                      igcm_n2, igcm_ar, igcm_o2, igcm_co
-      use surfdat_h, only: phisfi, z0, zmea, zstd, zsig, zgam, zthe,
-     &                     albedodat, z0_default, qsurf, tsurf,
-     &                     co2ice, emis
-      use comsoil_h, only: inertiedat, layer, mlayer, nsoilmx, tsoil
-      use control_mod, only: day_step, iphysiq, anneeref
-      use phyredem, only: physdem0, physdem1
-      use iostart, only: open_startphy
-      use comgeomphy, only: initcomgeomphy
-!      use planete_h
-      use dimradmars_mod, only: tauscaling
-      use turb_mod, only: q2
-      use comgeomfi_h, only: ini_fillgeom
-
-
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "description.h"
-#include "ener.h"
-#include "temps.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-#include "serre.h"
-#include "netcdf.inc"
-#include "datafile.h"
-c=======================================================================
-c   Declarations
-c=======================================================================
-
-c Variables dimension du fichier "start_archive"
-c------------------------------------
-      CHARACTER	relief*3
-
-c et autres:
-c----------
-
-c Variables pour les lectures NetCDF des fichiers "start_archive" 
-c--------------------------------------------------
-      INTEGER nid_dyn, nid_fi,nid,nvarid
-      INTEGER tab0
-
-      REAL  date
-      REAL p_rad,p_omeg,p_g,p_mugaz,p_daysec
-
-c Variable histoire 
-c------------------
-      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL phis(iip1,jjp1)
-      REAL,ALLOCATABLE :: q(:,:,:,:)               ! champs advectes
-
-c autre variables dynamique nouvelle grille
-c------------------------------------------
-      REAL pks(iip1,jjp1)
-      REAL w(iip1,jjp1,llm+1)
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-!      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-!      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
-      REAL phi(iip1,jjp1,llm)
-
-      integer klatdat,klongdat
-      PARAMETER (klatdat=180,klongdat=360)
-
-c Physique sur grille scalaire 
-c----------------------------
-      real zmeaS(iip1,jjp1),zstdS(iip1,jjp1)
-      real zsigS(iip1,jjp1),zgamS(iip1,jjp1),ztheS(iip1,jjp1)
-      real z0S(iip1,jjp1)
-
-c variable physique
-c------------------
-      REAL tauscadyn(iip1,jjp1) ! dust conversion factor on the dynamics grid
-      real alb(iip1,jjp1),albfi(ngridmx) ! albedos
-      real ith(iip1,jjp1,nsoilmx),ithfi(ngridmx,nsoilmx) ! thermal inertia (3D)
-      real surfith(iip1,jjp1),surfithfi(ngridmx) ! surface thermal inertia (2D)
-      REAL latfi(ngridmx),lonfi(ngridmx),airefi(ngridmx)
-
-      INTEGER i,j,l,isoil,ig,idum
-      real mugaz ! molar mass of the atmosphere
-
-      integer ierr  !, nbetat
-
-c Variables on the new grid along scalar points 
-c------------------------------------------------------
-!      REAL p(iip1,jjp1)
-      REAL t(iip1,jjp1,llm)
-      real phisold_newgrid(iip1,jjp1)
-      REAL :: teta(iip1, jjp1, llm)
-      REAL :: pk(iip1,jjp1,llm)
-      REAL :: pkf(iip1,jjp1,llm)
-      REAL :: ps(iip1, jjp1)
-      REAL :: masse(iip1,jjp1,llm)
-      REAL :: xpn,xps,xppn(iim),xpps(iim)
-      REAL :: p3d(iip1, jjp1, llm+1)
-      REAL :: beta(iip1,jjp1,llm)
-!      REAL dteta(ip1jmp1,llm)
-
-c Variable de l'ancienne grille 
-c------------------------------
-      real time
-      real tab_cntrl(100)
-      real tab_cntrl_bis(100)
-
-c variables diverses
-c-------------------
-      real choix_1 ! ==0 : read start_archive file ; ==1: read start files
-      character*80      fichnom
-      integer Lmodif,iq
-      integer flagthermo, flagh2o
-      character modif*20
-      real z_reel(iip1,jjp1)
-      real tsud,albsud,alb_bb,ith_bb,Tiso
-      real ptoto,pcap,patm,airetot,ptotn,patmn
-!      real ssum
-      character*1 yes
-      logical :: flagiso=.false. ,  flagps0=.false.
-      real val, val2, val3 ! to store temporary variables
-      real :: iceith=2000 ! thermal inertia of subterranean ice
-      real :: iceithN,iceithS ! values of thermal inertias in N & S hemispheres
-      integer iref,jref
-
-      INTEGER :: itau
-      
-      INTEGER :: numvanle
-      character(len=50) :: txt ! to store some text
-      integer :: count
-      real :: profile(llm+1) ! to store an atmospheric profile + surface value
-
-! MONS data:
-      real :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
-      real :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
-      ! coefficient to apply to convert d21 to 'true' depth (m)
-      real :: MONS_coeff
-      real :: MONS_coeffS ! coeff for southern hemisphere
-      real :: MONS_coeffN ! coeff for northern hemisphere
-!      real,parameter :: icedepthmin=1.e-3 ! Ice begins at most at that depth
-! Reference position for composition
-      real :: latref,lonref,dlatmin,dlonmin
-! Variable used to change composition
-      real :: Svmr,Smmr,Smmr_old,Smmr_new,Sn
-      real :: Mair_old,Mair_new,vmr_old,vmr_new
-      real,allocatable :: coefvmr(:)  ! Correction coefficient when changing composition
-      integer :: iloc(1), iqmax
-
-c sortie visu pour les champs dynamiques
-c---------------------------------------
-!      INTEGER :: visuid
-!      real :: time_step,t_ops,t_wrt
-!      CHARACTER*80 :: visu_file
-
-      cpp    = 744.499 ! for Mars, instead of 1004.70885 (Earth)
-      preff  = 610.    ! for Mars, instead of 101325. (Earth)
-      pa= 20           ! for Mars, instead of 500 (Earth)
-
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-! allocate arrays
-      allocate(q(iip1,jjp1,llm,nqtot))
-      allocate(coefvmr(nqtot))
-
-c=======================================================================
-c   Choice of the start file(s) to use
-c=======================================================================
-
-      write(*,*) 'From which kind of files do you want to create new',
-     .  'start and startfi files'
-      write(*,*) '    0 - from a file start_archive'
-      write(*,*) '    1 - from files start and startfi'
- 
-c-----------------------------------------------------------------------
-c   Open file(s) to modify (start or start_archive)
-c-----------------------------------------------------------------------
-
-      DO
-         read(*,*,iostat=ierr) choix_1
-         if ((choix_1 /= 0).OR.(choix_1 /=1)) EXIT
-      ENDDO
-
-c     Open start_archive
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start_archive.nc'
-        write(*,*)
-        fichnom = 'start_archive.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-        tab0 = 50 
-        Lmodif = 1
-
-c     OR open start and startfi files
-c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-      else
-        write(*,*) 'Creating start files from:'
-        write(*,*) './start.nc and ./startfi.nc'
-        write(*,*)
-        fichnom = 'start.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_dyn)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
- 
-        fichnom = 'startfi.nc'
-        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid_fi)
-        IF (ierr.NE.NF_NOERR) THEN
-          write(6,*)' Problem opening file:',fichnom
-          write(6,*)' ierr = ', ierr
-          CALL ABORT
-        ENDIF
-
-        tab0 = 0 
-        Lmodif = 0
-
-      endif
-
-c-----------------------------------------------------------------------
-c Lecture du tableau des parametres du run (pour la dynamique)
-c-----------------------------------------------------------------------
-
-      if (choix_1.eq.0) then
-
-        write(*,*) 'reading tab_cntrl START_ARCHIVE'
-c
-        ierr = NF_INQ_VARID (nid, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-c
-      else if (choix_1.eq.1) then
-
-        write(*,*) 'reading tab_cntrl START'
-c
-        ierr = NF_INQ_VARID (nid_dyn, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_dyn, nvarid, tab_cntrl)
-#else
-        ierr = NF_GET_VAR_REAL(nid_dyn, nvarid, tab_cntrl)
-#endif
-c
-        write(*,*) 'reading tab_cntrl STARTFI'
-c
-        ierr = NF_INQ_VARID (nid_fi, "controle", nvarid)
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid_fi, nvarid, tab_cntrl_bis)
-#else
-        ierr = NF_GET_VAR_REAL(nid_fi, nvarid, tab_cntrl_bis)
-#endif
-c
-        do i=1,50
-          tab_cntrl(i+50)=tab_cntrl_bis(i)
-        enddo
-      write(*,*) 'printing tab_cntrl', tab_cntrl
-      do i=1,100
-        write(*,*) i,tab_cntrl(i)
-      enddo
-      
-      endif
-c-----------------------------------------------------------------------
-c		Initialisation des constantes dynamique
-c-----------------------------------------------------------------------
-
-      kappa = tab_cntrl(9) 
-      etot0 = tab_cntrl(12)
-      ptot0 = tab_cntrl(13)
-      ztot0 = tab_cntrl(14)
-      stot0 = tab_cntrl(15)
-      ang0 = tab_cntrl(16)
-      write(*,*) "Newstart: kappa,etot0,ptot0,ztot0,stot0,ang0"
-      write(*,*) kappa,etot0,ptot0,ztot0,stot0,ang0
-
-c-----------------------------------------------------------------------
-c   Lecture du tab_cntrl et initialisation des constantes physiques
-c  - pour start:  Lmodif = 0 => pas de modifications possibles
-c                  (modif dans le tabfi de readfi + loin)
-c  - pour start_archive:  Lmodif = 1 => modifications possibles
-c-----------------------------------------------------------------------
-      if (choix_1.eq.0) then
-         ! tabfi requires that input file be first opened by open_startphy(fichnom)
-         fichnom = 'start_archive.nc'
-         call open_startphy(fichnom)
-         call tabfi (nid,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_mugaz,p_daysec,time)
-      else if (choix_1.eq.1) then
-         fichnom = 'startfi.nc'
-         call open_startphy(fichnom)
-         call tabfi (nid_fi,Lmodif,tab0,day_ini,lllm,p_rad,
-     .            p_omeg,p_g,p_mugaz,p_daysec,time)
-      endif
-
-      rad = p_rad
-      omeg = p_omeg
-      g = p_g
-      mugaz = p_mugaz
-      daysec = p_daysec
-!      write(*,*) 'aire',aire
-
-
-c=======================================================================
-c  INITIALISATIONS DIVERSES
-c=======================================================================
-
-      day_step=180 !?! Note: day_step is a common in "control.h"
-      CALL defrun_new( 99, .TRUE. )
-      CALL iniconst 
-      CALL inigeom
-      idum=-1
-      idum=0
-
-c Initialisation coordonnees /aires
-c -------------------------------
-! Note: rlatu(:) and rlonv(:) are commons defined in "comgeom.h"
-!       rlatu() and rlonv() are given in radians
-      latfi(1)=rlatu(1)
-      lonfi(1)=0.
-      DO j=2,jjm
-         DO i=1,iim
-            latfi((j-2)*iim+1+i)=rlatu(j)
-            lonfi((j-2)*iim+1+i)=rlonv(i)
-         ENDDO
-      ENDDO
-      latfi(ngridmx)=rlatu(jjp1)
-      lonfi(ngridmx)=0.
-      
-      ! build airefi(), mesh area on physics grid
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-      ! Poles are single points on physics grid
-      airefi(1)=sum(aire(1:iim,1))
-      airefi(ngridmx)=sum(aire(1:iim,jjm+1))
-
-! also initialize various physics flags/settings which might be needed
-!    (for instance initracer needs to know about some flags, and/or
-!      'datafile' path may be changed by user)
-      call phys_state_var_init(ngridmx,llm,nqtot,
-     .                         daysec,dtphys,rad,g,r,cpp)
-      call ini_fillgeom(ngridmx,latfi,lonfi,airefi)
-      call conf_phys(ngridmx,llm,nqtot)
-
-c=======================================================================
-c   lecture topographie, albedo, inertie thermique, relief sous-maille
-c=======================================================================
-
-      if (choix_1.ne.1) then  ! pour ne pas avoir besoin du fichier 
-                              ! surface.dat dans le cas des start
-
-c do while((relief(1:3).ne.'mol').AND.(relief(1:3).ne.'pla'))
-c       write(*,*)
-c       write(*,*) 'choix du relief (mola,pla)'
-c       write(*,*) '(Topographie MGS MOLA, plat)'
-c       read(*,fmt='(a3)') relief
-        relief="mola"
-c     enddo
-
-      CALL datareadnc(relief,phis,alb,surfith,z0S,
-     &          zmeaS,zstdS,zsigS,zgamS,ztheS)
-
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-!      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,surfith,surfithfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,z0S,z0)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zmeaS,zmea)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zstdS,zstd)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zsigS,zsig)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,zgamS,zgam)
-      CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ztheS,zthe)
-
-      endif ! of if (choix_1.ne.1)
-
-
-c=======================================================================
-c  Lecture des fichiers (start ou start_archive)
-c=======================================================================
-
-      if (choix_1.eq.0) then
-
-        write(*,*) 'Reading file START_ARCHIVE'
-        CALL lect_start_archive(ngridmx,llm,nqtot,
-     &   date,tsurf,tsoil,emis,q2,
-     &   t,ucov,vcov,ps,co2ice,teta,phisold_newgrid,q,qsurf,
-     &   tauscaling,surfith,nid)
-        write(*,*) "OK, read start_archive file"
-	! copy soil thermal inertia
-	ithfi(:,:)=inertiedat(:,:)
-	
-        ierr= NF_CLOSE(nid)
-
-      else if (choix_1.eq.1) then !  c'est l'appel a tabfi de phyeta0 qui
-                                  !  permet de changer les valeurs du 
-                                  !  tab_cntrl Lmodif=1
-        tab0=0
-        Lmodif=1 ! Lmodif set to 1 to allow modifications in phyeta0                           
-        write(*,*) 'Reading file START'
-        fichnom = 'start.nc'
-        CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,time)
-
-        write(*,*) 'Reading file STARTFI'
-        fichnom = 'startfi.nc'
-        CALL phyetat0 (fichnom,tab0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
-     .        day_ini,time,
-     .        tsurf,tsoil,emis,q2,qsurf,co2ice,tauscaling)
-        
-        ! copy albedo and soil thermal inertia
-        do i=1,ngridmx
-          albfi(i) = albedodat(i)
-	  do j=1,nsoilmx
-           ithfi(i,j) = inertiedat(i,j)
-	  enddo
-        ! build a surfithfi(:) using 1st layer of ithfi(:), which might
-        ! be neede later on if reinitializing soil thermal inertia
-          surfithfi(i)=ithfi(i,1)
-        enddo
-
-      else 
-        CALL exit(1)
-      endif
-
-      dtvr   = daysec/REAL(day_step)
-      dtphys   = dtvr * REAL(iphysiq)
-
-c=======================================================================
-c 
-c=======================================================================
-! If tracer names follow 'old' convention (q01, q02, ...) then
-! rename them
-      count=0
-      do iq=1,nqtot
-        txt=" "
-        write(txt,'(a1,i2.2)') 'q',iq
-        if (txt.eq.tname(iq)) then
-          count=count+1
-        endif
-      enddo ! of do iq=1,nqtot
-      
-      ! initialize tracer names noms(:) and indexes (igcm_co2, igcm_h2o_vap, ...)
-      call initracer(ngridmx,nqtot,qsurf)
-      
-      if (count.eq.nqtot) then
-        write(*,*) 'Newstart: updating tracer names'
-        ! copy noms(:) to tname(:) to have matching tracer names in physics
-        ! and dynamics
-        tname(1:nqtot)=noms(1:nqtot)
-      endif
-
-c=======================================================================
-c 
-c=======================================================================
-
-      do ! infinite loop on list of changes
-
-      write(*,*)
-      write(*,*)
-      write(*,*) 'List of possible changes :'
-      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~'
-      write(*,*)
-      write(*,*) 'flat         : no topography ("aquaplanet")'
-      write(*,*) 'bilball      : uniform albedo and thermal inertia'
-      write(*,*) 'z0           : set a uniform surface roughness length'
-      write(*,*) 'coldspole    : cold subsurface and high albedo at
-     $ S.Pole'
-      write(*,*) 'qname        : change tracer name'
-      write(*,*) 'q=0          : ALL tracer =zero'
-      write(*,*) 'q=x          : give a specific uniform value to one
-     $ tracer'
-      write(*,*) 'q=profile    : specify a profile for a tracer'
-      write(*,*) 'freedust     : rescale dust to a true value'
-      write(*,*) 'ini_q        : tracers initialization for chemistry
-     $ and water vapour'
-      write(*,*) 'ini_q-h2o    : tracers initialization for chemistry
-     $ only'
-      write(*,*) 'composition  : change atm main composition: CO2,N2,Ar,
-     $ O2,CO'
-      write(*,*) 'ini_h2osurf  : reinitialize surface water ice '
-      write(*,*) 'noglacier    : Remove tropical H2O ice if |lat|<45'
-      write(*,*) 'watercapn    : H20 ice on permanent N polar cap '
-      write(*,*) 'watercaps    : H20 ice on permanent S polar cap '
-      write(*,*) 'wetstart     : start with a wet atmosphere'
-      write(*,*) 'isotherm     : Isothermal Temperatures, wind set to
-     $ zero'
-      write(*,*) 'co2ice=0     : remove CO2 polar cap'
-      write(*,*) 'ptot         : change total pressure'
-      write(*,*) 'therm_ini_s  : set soil thermal inertia to reference
-     $ surface values'
-      write(*,*) 'subsoilice_n : put deep underground ice layer in
-     $ northern hemisphere'
-      write(*,*) 'subsoilice_s : put deep underground ice layer in
-     $ southern hemisphere'
-      write(*,*) 'mons_ice     : put underground ice layer according
-     $ to MONS derived data'
-
-        write(*,*)
-        write(*,*) 'Change to perform ?'
-        write(*,*) '   (enter keyword or return to end)'
-        write(*,*)
-
-        read(*,fmt='(a20)') modif
-        if (modif(1:1) .eq. ' ') exit ! exit loop on changes
-
-        write(*,*)
-        write(*,*) trim(modif) , ' : '
-
-c       'flat : no topography ("aquaplanet")'
-c       -------------------------------------
-        if (trim(modif) .eq. 'flat') then
-c         set topo to zero 
-          CALL initial0(ip1jmp1,z_reel)
-          CALL multscal(ip1jmp1,z_reel,g,phis)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,phisfi)
-          write(*,*) 'topography set to zero.'
-          write(*,*) 'WARNING : the subgrid topography parameters',
-     &    ' were not set to zero ! => set calllott to F'                    
-
-c        Choice for surface pressure
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to choose homogeneous surface',
-     &                 'pressure (y) or let newstart interpolate ',
-     &                 ' the previous field  (n)?'
-             read(*,fmt='(a)') yes
-         end do
-         if (yes.eq.'y') then
-           flagps0=.true.
-           write(*,*) 'New value for ps (Pa) ?'
- 201       read(*,*,iostat=ierr) patm
-            if(ierr.ne.0) goto 201
-             write(*,*)
-             write(*,*) ' new ps everywhere (Pa) = ', patm
-             write(*,*)
-             do j=1,jjp1
-               do i=1,iip1
-                 ps(i,j)=patm
-               enddo
-             enddo
-         end if
-
-c       bilball : albedo, inertie thermique uniforme
-c       --------------------------------------------
-        else if (trim(modif) .eq. 'bilball') then
-          write(*,*) 'constante albedo and iner.therm:'
-          write(*,*) 'New value for albedo (ex: 0.25) ?'
- 101      read(*,*,iostat=ierr) alb_bb
-          if(ierr.ne.0) goto 101
-          write(*,*)
-          write(*,*) ' uniform albedo (new value):',alb_bb
-          write(*,*)
-
-          write(*,*) 'New value for thermal inertia (eg: 247) ?'
- 102      read(*,*,iostat=ierr) ith_bb
-          if(ierr.ne.0) goto 102
-          write(*,*) 'uniform thermal inertia (new value):',ith_bb
-          DO j=1,jjp1
-             DO i=1,iip1
-                alb(i,j) = alb_bb	! albedo
-		do isoil=1,nsoilmx
-                  ith(i,j,isoil) = ith_bb	! thermal inertia
-		enddo
-             END DO
-          END DO
-!          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-        
-         ! also reset surface roughness length to default value
-         write(*,*) 'surface roughness length set to:',z0_default,' m'
-         z0(:)=z0_default
-
-!       z0 : set surface roughness length to a constant value
-!       -----------------------------------------------------
-        else if (trim(modif) .eq. 'z0') then
-          write(*,*) 'set a uniform surface roughness length'
-          write(*,*) ' value for z0_default (ex: ',z0_default,')?'
-          ierr=1
-          do while (ierr.ne.0)
-            read(*,*,iostat=ierr) z0_default
-          enddo
-          z0(:)=z0_default
-
-c       coldspole : sous-sol de la calotte sud toujours froid
-c       -----------------------------------------------------
-        else if (trim(modif) .eq. 'coldspole') then
-          write(*,*)'new value for the subsurface temperature',
-     &   ' beneath the permanent southern polar cap ? (eg: 141 K)'
- 103      read(*,*,iostat=ierr) tsud
-          if(ierr.ne.0) goto 103
-          write(*,*)
-          write(*,*) ' new value of the subsurface temperature:',tsud
-c         nouvelle temperature sous la calotte permanente
-          do l=2,nsoilmx
-               tsoil(ngridmx,l) =  tsud
-          end do
-
-
-          write(*,*)'new value for the albedo',
-     &   'of the permanent southern polar cap ? (eg: 0.75)'
- 104      read(*,*,iostat=ierr) albsud
-          if(ierr.ne.0) goto 104
-          write(*,*)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-c         Option 1:  only the albedo of the pole is modified :    
-          albfi(ngridmx)=albsud
-          write(*,*) 'ig=',ngridmx,'   albedo perennial cap ',
-     &    albfi(ngridmx)
-
-c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
-c          Option 2 A haute resolution : coordonnee de la vrai calotte ~    
-c           DO j=1,jjp1
-c             DO i=1,iip1
-c                ig=1+(j-2)*iim +i
-c                if(j.eq.1) ig=1
-c                if(j.eq.jjp1) ig=ngridmx
-c                if ((rlatu(j)*180./pi.lt.-84.).and.
-c     &            (rlatu(j)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.gt.-91.).and.
-c     &            (rlonv(i)*180./pi.lt.0.))         then
-cc    albedo de la calotte permanente fixe a albsud
-c                   alb(i,j)=albsud
-c                   write(*,*) 'lat=',rlatu(j)*180./pi,
-c     &                      ' lon=',rlonv(i)*180./pi
-cc     fin de la condition sur les limites de la calotte permanente
-c                end if
-c             ENDDO
-c          ENDDO
-c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-c         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,alb,albfi)
-
-
-c       ptot : Modification of the total pressure: ice + current atmosphere 
-c       -------------------------------------------------------------------
-        else if (trim(modif) .eq. 'ptot') then
-
-c         calcul de la pression totale glace + atm actuelle
-          patm=0.
-          airetot=0.
-          pcap=0.
-          DO j=1,jjp1
-             DO i=1,iim
-                ig=1+(j-2)*iim +i
-                if(j.eq.1) ig=1
-                if(j.eq.jjp1) ig=ngridmx
-                patm = patm + ps(i,j)*aire(i,j)
-                airetot= airetot + aire(i,j)
-                pcap = pcap + aire(i,j)*co2ice(ig)*g
-             ENDDO
-          ENDDO
-          ptoto = pcap + patm
-
-          print*,'Current total pressure at surface (co2 ice + atm) ',
-     &       ptoto/airetot
-
-          print*,'new value?'
-          read(*,*) ptotn
-          ptotn=ptotn*airetot
-          patmn=ptotn-pcap
-          print*,'ptoto,patm,ptotn,patmn'
-          print*,ptoto,patm,ptotn,patmn
-          print*,'Mult. factor for pressure (atm only)', patmn/patm
-          do j=1,jjp1
-             do i=1,iip1
-                ps(i,j)=ps(i,j)*patmn/patm
-             enddo
-          enddo
-
-c        Correction pour la conservation des traceurs
-         yes=' '
-         do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*) 'Do you wish to conserve tracer total mass (y)',
-     &              ' or tracer mixing ratio (n) ?'
-             read(*,fmt='(a)') yes
-         end do
-
-         if (yes.eq.'y') then
-           write(*,*) 'OK : conservation of tracer total mass'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=q(i,j,l,iq)*patm/patmn
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-          else
-            write(*,*) 'OK : conservation of tracer mixing ratio'
-          end if
-
-c       qname : change tracer name
-c       --------------------------
-        else if (trim(modif).eq.'qname') then
-         yes='y'
-         do while (yes.eq.'y')
-          write(*,*) 'Which tracer name do you want to change ?'
-          do iq=1,nqtot
-            write(*,'(i3,a3,a20)')iq,' : ',trim(tname(iq))
-          enddo
-          write(*,'(a35,i3)')
-     &            '(enter tracer number; between 1 and ',nqtot
-          write(*,*)' or any other value to quit this option)'
-          read(*,*) iq
-          if ((iq.ge.1).and.(iq.le.nqtot)) then
-            write(*,*)'Change tracer name ',trim(tname(iq)),' to ?'
-            read(*,*) txt
-            tname(iq)=txt
-            write(*,*)'Do you want to change another tracer name (y/n)?'
-            read(*,'(a)') yes 
-          else
-! inapropiate value of iq; quit this option
-            yes='n'
-          endif ! of if ((iq.ge.1).and.(iq.le.nqtot))
-         enddo ! of do while (yes.ne.'y')
-
-c       q=0 : set tracers to zero
-c       -------------------------
-        else if (trim(modif) .eq. 'q=0') then
-c          mise a 0 des q (traceurs)
-          write(*,*) 'Tracers set to 0 (1.E-30 in fact)'
-           DO iq =1, nqtot
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=1.e-30
-                  ENDDO
-               ENDDO
-             ENDDO
-           ENDDO
-
-c          set surface tracers to zero
-           DO iq =1, nqtot
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=0.
-             ENDDO
-           ENDDO
-
-c       q=x : initialise tracer manually 
-c       --------------------------------
-        else if (trim(modif) .eq. 'q=x') then
-             write(*,*) 'Which tracer do you want to modify ?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             if ((iq.lt.1).or.(iq.gt.nqtot)) then
-               ! wrong value for iq, go back to menu
-               write(*,*) "wrong input value:",iq
-               cycle
-             endif
-             write(*,*)'mixing ratio of tracer ',trim(tname(iq)),
-     &                 ' ? (kg/kg)'
-             read(*,*) val
-             DO l=1,llm
-               DO j=1,jjp1
-                  DO i=1,iip1
-                    q(i,j,l,iq)=val
-                  ENDDO
-               ENDDO
-             ENDDO
-             write(*,*) 'SURFACE value of tracer ',trim(tname(iq)),
-     &                   ' ? (kg/m2)'
-             read(*,*) val
-             DO ig=1,ngridmx
-                 qsurf(ig,iq)=val
-             ENDDO
-
-c       q=profile : initialize tracer with a given profile
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'q=profile') then
-             write(*,*) 'Tracer profile will be sought in ASCII file'
-             write(*,*) "'profile_tracer' where 'tracer' is tracer name"
-             write(*,*) "(one value per line in file; starting with"
-             write(*,*) "surface value, the 1st atmospheric layer"
-             write(*,*) "followed by 2nd, etc. up to top of atmosphere)"
-             write(*,*) 'Which tracer do you want to set?'
-             do iq=1,nqtot
-               write(*,*)iq,' : ',trim(tname(iq))
-             enddo
-             write(*,*) '(choose between 1 and ',nqtot,')'
-             read(*,*) iq 
-             if ((iq.lt.1).or.(iq.gt.nqtot)) then
-               ! wrong value for iq, go back to menu
-               write(*,*) "wrong input value:",iq
-               cycle
-             endif
-             ! look for input file 'profile_tracer'
-             txt="profile_"//trim(tname(iq))
-             open(41,file=trim(txt),status='old',form='formatted',
-     &            iostat=ierr)
-             if (ierr.eq.0) then
-               ! OK, found file 'profile_...', load the profile
-               do l=1,llm+1
-                 read(41,*,iostat=ierr) profile(l)
-                 if (ierr.ne.0) then ! something went wrong
-                   exit ! quit loop
-                 endif
-               enddo
-               if (ierr.eq.0) then
-                 ! initialize tracer values
-                 qsurf(:,iq)=profile(1)
-                 do l=1,llm
-                   q(:,:,l,iq)=profile(l+1)
-                 enddo
-                 write(*,*)'OK, tracer ',trim(tname(iq)),
-     &               ' initialized ','using values from file ',trim(txt)
-               else
-                 write(*,*)'problem reading file ',trim(txt),' !'
-                 write(*,*)'No modifications to tracer ',trim(tname(iq))
-               endif
-             else
-               write(*,*)'Could not find file ',trim(txt),' !'
-               write(*,*)'No modifications to tracer ',trim(tname(iq))
-             endif
-             
-c       convert dust from virtual to true values
-c       --------------------------------------------------
-        else if (trim(modif) .eq. 'freedust') then
-         if (minval(tauscaling) .lt. 0) then
-           write(*,*) 'WARNING conversion factor negative'
-           write(*,*) 'This is probably because it was not present
-     &in the file'
-           write(*,*) 'A constant conversion is used instead.'
-           tauscaling(:) = 1.e-3
-         endif
-         CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscadyn)
-          do l=1,llm
-            do j=1,jjp1
-              do i=1,iip1
-                if (igcm_dust_number .ne. 0) 
-     &            q(i,j,l,igcm_dust_number) =
-     &            q(i,j,l,igcm_dust_number) * tauscadyn(i,j)
-                if (igcm_dust_mass .ne. 0) 
-     &            q(i,j,l,igcm_dust_mass) =
-     &            q(i,j,l,igcm_dust_mass) * tauscadyn(i,j)
-                if (igcm_ccn_number .ne. 0) 
-     &            q(i,j,l,igcm_ccn_number) =
-     &            q(i,j,l,igcm_ccn_number) * tauscadyn(i,j)
-                if (igcm_ccn_mass .ne. 0) 
-     &            q(i,j,l,igcm_ccn_mass) =
-     &            q(i,j,l,igcm_ccn_mass) * tauscadyn(i,j)
-              end do
-            end do
-          end do
-
-          tauscaling(:) = 1.
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'done rescaling to true vale'
-
-c       ini_q : Initialize tracers for chemistry
-c       -----------------------------------------------
-        else if (trim(modif) .eq. 'ini_q') then
-          flagh2o    = 1
-          flagthermo = 0
-          yes=' '
-c         For more than 32 layers, possible to initiate thermosphere only     
-          if (llm.gt.32) then 
-            do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*)'',
-     &     'initialisation for thermosphere only? (y/n)'
-            read(*,fmt='(a)') yes
-            if (yes.eq.'y') then
-            flagthermo=1 
-            else
-            flagthermo=0
-            endif
-            enddo  
-          endif
-          
-          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
-     &                          flagh2o, flagthermo)
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'inichim_newstart: chemical species and
-     $ water vapour initialised'
-
-c       ini_q-h2o : as above except for the water vapour tracer 
-c       ------------------------------------------------------
-        else if (trim(modif) .eq. 'ini_q-h2o') then
-          flagh2o    = 0
-          flagthermo = 0
-          yes=' '
-          ! for more than 32 layers, possible to initiate thermosphere only     
-          if(llm.gt.32) then
-            do while ((yes.ne.'y').and.(yes.ne.'n'))
-            write(*,*)'',
-     &      'initialisation for thermosphere only? (y/n)'
-            read(*,fmt='(a)') yes
-            if (yes.eq.'y') then 
-            flagthermo=1 
-            else
-            flagthermo=0
-            endif
-            enddo
-          endif
-
-          call inichim_newstart(ngridmx, nqtot, q, qsurf, ps, 
-     &                          flagh2o, flagthermo)
-
-         ! We want to have the very same value at lon -180 and lon 180
-          do l = 1,llm
-             do j = 1,jjp1
-                do iq = 1,nqtot
-                   q(iip1,j,l,iq) = q(1,j,l,iq)
-                end do
-             end do
-          end do
-
-          write(*,*) 'inichim_newstart: chemical species initialised
-     $ (except water vapour)'
-
-c      composition : change main composition: CO2,N2,Ar,O2,CO (FF 03/2014)
-c      --------------------------------------------------------
-       else if (trim(modif) .eq. 'composition') then
-          write(*,*) "Lat (degN)  lon (degE) of the reference site ?"
-          write(*,*) "e.g. MSL : -4.5  137.  "
- 301      read(*,*,iostat=ierr) latref, lonref
-          if(ierr.ne.0) goto 301
-
-
-        !  Select GCM point close to reference site
-          dlonmin =90.
-          DO i=1,iip1-1
-             if (abs(rlonv(i)*180./pi -lonref).lt.dlonmin)then
-                iref=i
-                dlonmin=abs(rlonv(i)*180./pi -lonref)
-             end if   
-          ENDDO
-          dlatmin =45.
-          DO j=1,jjp1
-             if (abs(rlatu(j)*180./pi -latref).lt.dlatmin)then
-                jref=j
-                dlatmin=abs(rlatu(j)*180./pi -latref)
-             end if   
-          ENDDO
-          write(*,*) "In GCM : lat= " ,  rlatu(jref)*180./pi
-          write(*,*) "In GCM : lon= " ,  rlonv(iref)*180./pi
-          write(*,*)
-
-        ! Compute air molar mass at reference site
-          Smmr=0
-          Sn = 0
-          do iq=1,nqtot 
-             if ((iq.eq.igcm_co2).or.(iq.eq.igcm_n2)
-     &      .or. (iq.eq.igcm_ar).or.(iq.eq.igcm_o2)
-     &      .or. (iq.eq.igcm_co)) then
-                 Smmr=Smmr+q(iref,jref,1,iq)
-                 Sn=Sn+q(iref,jref,1,iq)/mmol(iq) 
-             end if
-          end do
-          write(*,*) "At reference site :  "
-          write(*,*) "Sum of mass mix. ratio (should be about 1)=",Smmr
-          Mair_old =Smmr/Sn
-          write(*,*)
-     &     "Air molar mass (g/mol) at reference site= ",Mair_old
-
-        ! Ask for new volume mixing ratio at reference site
-          Svmr =0.
-          Sn =0.
-          do iq=1,nqtot 
-           coefvmr(iq) = 1.
-           if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &     .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-
-             vmr_old=q(iref,jref,1,iq)*Mair_old/mmol(iq)  
-             write(*,*) "Previous vmr("//trim(tname(iq))//")= ", vmr_old
-
-              if (iq.eq.igcm_n2) then
-                write(*,*) "New vmr(n2)? (MSL: 2.03e-02 at Ls~184)"
-              endif
-              if (iq.eq.igcm_ar) then
-                write(*,*) "New vmr(ar)? (MSL: 2.07e-02 at Ls~184)"
-              endif
-              if (iq.eq.igcm_o2) then
-                write(*,*) "New vmr(o2)? (MSL: 1.73e-03 at Ls~184)"
-              endif
-              if (iq.eq.igcm_co) then
-                write(*,*) "New vmr(co)? (MSL: 7.49e-04 at Ls~184)"
-              endif
- 302          read(*,*,iostat=ierr) vmr_new
-              if(ierr.ne.0) goto 302
-              write(*,*) "New vmr("//trim(tname(iq))//")= ",vmr_new
-              write(*,*) 
-              coefvmr(iq) = vmr_new/vmr_old
-              Svmr=Svmr+vmr_new
-              Sn=Sn+vmr_new*mmol(iq)
-           end if
-          enddo ! of do iq=1,nqtot 
-      !  Estimation of new Air molar mass at reference site (assuming vmr_co2 = 1-Svmr)
-          Mair_new = Sn + (1-Svmr)*mmol(igcm_co2) 
-          write(*,*)
-     &     "NEW Air molar mass (g/mol) at reference site= ",Mair_new
-
-        ! Compute mass mixing ratio changes  
-          do iq=1,nqtot  
-            if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &          .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-             write(*,*) "Everywhere mmr("//trim(tname(iq))//
-     &        ") is multiplied by ",coefvmr(iq)*Mair_old/Mair_new
-            end if
-          end do
-
-        ! Recompute mass mixing ratios everywhere, and adjust mmr of most abundant species
-        ! to keep sum of mmr constant.
-          do l=1,llm
-           do j=1,jjp1
-            do i=1,iip1
-              Smmr_old = 0.
-              Smmr_new = 0.
-              do iq=1,nqtot  
-                if ((iq.eq.igcm_n2).or.(iq.eq.igcm_ar)
-     &         .or. (iq.eq.igcm_o2).or.(iq.eq.igcm_co)) then
-                   Smmr_old = Smmr_old + q(i,j,l,iq) ! sum of old mmr 
-                   q(i,j,l,iq)=q(i,j,l,iq)*coefvmr(iq)*Mair_old/Mair_new
-                   Smmr_new = Smmr_new + q(i,j,l,iq) ! sum of new mmr
-                end if 
-              enddo
-              iloc = maxloc(q(i,j,l,:))
-              iqmax = iloc(1)
-              q(i,j,l,iqmax) = q(i,j,l,iqmax) + Smmr_old - Smmr_new
-            enddo
-           enddo
-          enddo
-
-          write(*,*)
-     &   "The most abundant species is modified everywhere to keep "//
-     &   "sum of mmr constant"
-          write(*,*) 'At reference site vmr(CO2)=', 
-     &        q(iref,jref,1,igcm_co2)*Mair_new/mmol(igcm_co2)
-          write(*,*) "Compared to MSL observation: vmr(CO2)= 0.957 "//
-     &   "at Ls=184" 
-
-c      wetstart : wet atmosphere with a north to south gradient
-c      --------------------------------------------------------
-       else if (trim(modif) .eq. 'wetstart') then
-        ! check that there is indeed a water vapor tracer
-        if (igcm_h2o_vap.eq.0) then
-          write(*,*) "No water vapour tracer! Can't use this option"
-          stop
-        endif
-          DO l=1,llm
-            DO j=1,jjp1
-              DO i=1,iip1-1
-                q(i,j,l,igcm_h2o_vap)=150.e-6 * (rlatu(j)+pi/2.) / pi
-              ENDDO
-              ! We want to have the very same value at lon -180 and lon 180
-              q(iip1,j,l,igcm_h2o_vap) = q(1,j,l,igcm_h2o_vap)
-            ENDDO
-          ENDDO
-
-         write(*,*) 'Water mass mixing ratio at north pole='
-     *               ,q(1,1,1,igcm_h2o_vap)
-         write(*,*) '---------------------------south pole='
-     *               ,q(1,jjp1,1,igcm_h2o_vap)
-
-c      ini_h2osurf : reinitialize surface water ice
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'ini_h2osurf') then
-          write(*,*)'max surface ice left?(e.g. 0.2 kg/m2=200microns)'
- 207      read(*,*,iostat=ierr) val
-          if(ierr.ne.0) goto 207
-          write(*,*)'also set negative values of surf ice to 0'
-           do ig=1,ngridmx
-              qsurf(ig,igcm_h2o_ice)=min(val,qsurf(ig,igcm_h2o_ice))
-              qsurf(ig,igcm_h2o_ice)=max(0.,qsurf(ig,igcm_h2o_ice))
-           end do
-
-c      noglacier : remove tropical water ice (to initialize high res sim)
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'noglacier') then
-           do ig=1,ngridmx
-             j=(ig-2)/iim +2
-              if(ig.eq.1) j=1
-              write(*,*) 'OK: remove surface ice for |lat|<45'
-              if (abs(rlatu(j)*180./pi).lt.45.) then
-                   qsurf(ig,igcm_h2o_ice)=0.
-              end if
-           end do
-
-
-c      watercapn : H20 ice on permanent northern cap
-c      --------------------------------------------------
-        else if (trim(modif) .eq. 'watercapn') then
-           do ig=1,ngridmx
-             j=(ig-2)/iim +2
-              if(ig.eq.1) j=1
-              if (rlatu(j)*180./pi.gt.80.) then
-                   qsurf(ig,igcm_h2o_ice)=1.e5
-                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
-     &              qsurf(ig,igcm_h2o_ice)
-                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
-     &              rlatv(j)*180./pi
-                end if
-           enddo
-
-c      watercaps : H20 ice on permanent southern cap
-c      -------------------------------------------------
-        else if (trim(modif) .eq. 'watercaps') then
-           do ig=1,ngridmx
-               j=(ig-2)/iim +2
-               if(ig.eq.1) j=1
-               if (rlatu(j)*180./pi.lt.-80.) then
-                   qsurf(ig,igcm_h2o_ice)=1.e5
-                   write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
-     &              qsurf(ig,igcm_h2o_ice)
-                   write(*,*)'     ==> Ice mesh North boundary (deg)= ',
-     &              rlatv(j-1)*180./pi
-               end if
-           enddo
-
-c       isotherm : Isothermal temperatures and no winds
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'isotherm') then
-
-          write(*,*)'Isothermal temperature of the atmosphere, 
-     &           surface and subsurface'
-          write(*,*) 'Value of this temperature ? :'
- 203      read(*,*,iostat=ierr) Tiso
-          if(ierr.ne.0) goto 203
-
-          do ig=1, ngridmx
-            tsurf(ig) = Tiso
-          end do
-          do l=2,nsoilmx
-            do ig=1, ngridmx
-              tsoil(ig,l) = Tiso
-            end do
-          end do
-          flagiso=.true.
-          call initial0(llm*ip1jmp1,ucov)
-          call initial0(llm*ip1jm,vcov)
-          call initial0(ngridmx*(llm+1),q2)
-
-c       co2ice=0 : remove CO2 polar ice caps'
-c       ------------------------------------------------
-        else if (trim(modif) .eq. 'co2ice=0') then
-           do ig=1,ngridmx
-              co2ice(ig)=0
-              emis(ig)=emis(ngridmx/2)
-           end do
-        
-!       therm_ini_s: (re)-set soil thermal inertia to reference surface values
-!       ----------------------------------------------------------------------
-
-	else if (trim(modif).eq.'therm_ini_s') then
-!          write(*,*)"surfithfi(1):",surfithfi(1)
-	  do isoil=1,nsoilmx
-	    inertiedat(1:ngridmx,isoil)=surfithfi(1:ngridmx)
-	  enddo
-          write(*,*)'OK: Soil thermal inertia has been reset to referenc
-     &e surface values'
-!	  write(*,*)"inertiedat(1,1):",inertiedat(1,1)
-	  ithfi(:,:)=inertiedat(:,:)
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-! Check:
-!         do i=1,iip1
-!           do j=1,jjp1
-!             do isoil=1,nsoilmx
-!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
-!             enddo
-!           enddo
-!	 enddo
-
-!       subsoilice_n: Put deep ice layer in northern hemisphere soil
-!       ------------------------------------------------------------
-
-	else if (trim(modif).eq.'subsoilice_n') then
-
-         write(*,*)'From which latitude (in deg.), up to the north pole,
-     &should we put subterranean ice?'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val
-	  if (ierr.eq.0) then ! got a value
-	    ! do a sanity check
-	    if((val.lt.0.).or.(val.gt.90)) then
-	      write(*,*)'Latitude should be between 0 and 90 deg. !!!'
-	      ierr=1
-	    else ! find corresponding jref (nearest latitude)
-	      ! note: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-	      do j=1,jjp1
-	        if ((rlatu(j)*180./pi.ge.val).and.
-     &              (rlatu(j+1)*180./pi.le.val)) then
-		  ! find which grid point is nearest to val:
-		  if (abs(rlatu(j)*180./pi-val).le.
-     &                abs((rlatu(j+1)*180./pi-val))) then
-		   jref=j
-		  else
-		   jref=j+1
-		  endif
-		 
-		 write(*,*)'Will use nearest grid latitude which is:',
-     &                     rlatu(jref)*180./pi
-		endif
-	      enddo ! of do j=1,jjp1
-	    endif ! of if((val.lt.0.).or.(val.gt.90))
-	  endif !of if (ierr.eq.0)
-	 enddo ! of do while
-
-         ! Build layers() (as in soil_settings.F)
-	 val2=sqrt(mlayer(0)*mlayer(1))
-	 val3=mlayer(1)/mlayer(0)
-	 do isoil=1,nsoilmx
-	   layer(isoil)=val2*(val3**(isoil-1))
-	 enddo
-
-         write(*,*)'At which depth (in m.) does the ice layer begin?'
-         write(*,*)'(currently, the deepest soil layer extends down to:'
-     &              ,layer(nsoilmx),')'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val2
-!	  write(*,*)'val2:',val2,'ierr=',ierr
-	  if (ierr.eq.0) then ! got a value, but do a sanity check
-	    if(val2.gt.layer(nsoilmx)) then
-	      write(*,*)'Depth should be less than ',layer(nsoilmx)
-	      ierr=1
-	    endif
-	    if(val2.lt.layer(1)) then
-	      write(*,*)'Depth should be more than ',layer(1)
-	      ierr=1
-	    endif
-	  endif
-         enddo ! of do while
-	 
-	 ! find the reference index iref the depth corresponds to
-!	 if (val2.lt.layer(1)) then
-!	  iref=1
-!	 else
-	  do isoil=1,nsoilmx-1
-	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
-     &       then
-	     iref=isoil
-	     exit
-	   endif
-	  enddo
-!	 endif
-	 
-!	 write(*,*)'iref:',iref,'  jref:',jref
-!	 write(*,*)'layer',layer
-!	 write(*,*)'mlayer',mlayer
-         
-	 ! thermal inertia of the ice:
-	 ierr=1
-	 do while (ierr.ne.0)
-          write(*,*)'What is the value of subterranean ice thermal inert
-     &ia? (e.g.: 2000)'
-          read(*,*,iostat=ierr)iceith
-	 enddo ! of do while
-	 
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-	 
-	 do j=1,jref
-!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
-	    do i=1,iip1 ! loop on longitudes
-	     ! Build "equivalent" thermal inertia for the mixed layer
-	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
-     &                      ((layer(iref+1)-val2)/(iceith)**2)))
-	     ! Set thermal inertia of lower layers
-	     do isoil=iref+2,nsoilmx
-	      ith(i,j,isoil)=iceith ! ice
-	     enddo
-	    enddo ! of do i=1,iip1 
-	 enddo ! of do j=1,jjp1
-	 
-
-	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-!         do i=1,nsoilmx
-!	  write(*,*)'i:',i,'ithfi(1,i):',ithfi(1,i)
-!	 enddo
-
-	
-!       subsoilice_s: Put deep ice layer in southern hemisphere soil
-!       ------------------------------------------------------------
-
-	else if (trim(modif).eq.'subsoilice_s') then
-
-         write(*,*)'From which latitude (in deg.), down to the south pol
-     &e, should we put subterranean ice?'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val
-	  if (ierr.eq.0) then ! got a value
-	    ! do a sanity check
-	    if((val.gt.0.).or.(val.lt.-90)) then
-	      write(*,*)'Latitude should be between 0 and -90 deg. !!!'
-	      ierr=1
-	    else ! find corresponding jref (nearest latitude)
-	      ! note: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-	      do j=1,jjp1
-	        if ((rlatu(j)*180./pi.ge.val).and.
-     &              (rlatu(j+1)*180./pi.le.val)) then
-		  ! find which grid point is nearest to val:
-		  if (abs(rlatu(j)*180./pi-val).le.
-     &                abs((rlatu(j+1)*180./pi-val))) then
-		   jref=j
-		  else
-		   jref=j+1
-		  endif
-		 
-		 write(*,*)'Will use nearest grid latitude which is:',
-     &                     rlatu(jref)*180./pi
-		endif
-	      enddo ! of do j=1,jjp1
-	    endif ! of if((val.lt.0.).or.(val.gt.90))
-	  endif !of if (ierr.eq.0)
-	 enddo ! of do while
-
-         ! Build layers() (as in soil_settings.F)
-	 val2=sqrt(mlayer(0)*mlayer(1))
-	 val3=mlayer(1)/mlayer(0)
-	 do isoil=1,nsoilmx
-	   layer(isoil)=val2*(val3**(isoil-1))
-	 enddo
-
-         write(*,*)'At which depth (in m.) does the ice layer begin?'
-         write(*,*)'(currently, the deepest soil layer extends down to:'
-     &              ,layer(nsoilmx),')'
-	 ierr=1
-	 do while (ierr.ne.0)
-	  read(*,*,iostat=ierr) val2
-!	  write(*,*)'val2:',val2,'ierr=',ierr
-	  if (ierr.eq.0) then ! got a value, but do a sanity check
-	    if(val2.gt.layer(nsoilmx)) then
-	      write(*,*)'Depth should be less than ',layer(nsoilmx)
-	      ierr=1
-	    endif
-	    if(val2.lt.layer(1)) then
-	      write(*,*)'Depth should be more than ',layer(1)
-	      ierr=1
-	    endif
-	  endif
-         enddo ! of do while
-	 
-	 ! find the reference index iref the depth corresponds to
-	  do isoil=1,nsoilmx-1
-	   if((val2.gt.layer(isoil)).and.(val2.lt.layer(isoil+1)))
-     &       then
-	     iref=isoil
-	     exit
-	   endif
-	  enddo
-	 
-!	 write(*,*)'iref:',iref,'  jref:',jref
-         
-	 ! thermal inertia of the ice:
-	 ierr=1
-	 do while (ierr.ne.0)
-          write(*,*)'What is the value of subterranean ice thermal inert
-     &ia? (e.g.: 2000)'
-          read(*,*,iostat=ierr)iceith
-	 enddo ! of do while
-	 
-	 ! recast ithfi() onto ith()
-	 call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-	 
-	 do j=jref,jjp1
-!	    write(*,*)'j:',j,'rlatu(j)*180./pi:',rlatu(j)*180./pi
-	    do i=1,iip1 ! loop on longitudes
-	     ! Build "equivalent" thermal inertia for the mixed layer
-	     ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val2-layer(iref))/(ith(i,j,iref)**2))+
-     &                      ((layer(iref+1)-val2)/(iceith)**2)))
-	     ! Set thermal inertia of lower layers
-	     do isoil=iref+2,nsoilmx
-	      ith(i,j,isoil)=iceith ! ice
-	     enddo
-	    enddo ! of do i=1,iip1 
-	 enddo ! of do j=jref,jjp1
-	 
-
-	 CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-
-c       'mons_ice' : use MONS data to build subsurface ice table
-c       --------------------------------------------------------
-        else if (trim(modif).eq.'mons_ice') then
-        
-       ! 1. Load MONS data
-        call load_MONS_data(MONS_Hdn,MONS_d21)
-        
-        ! 2. Get parameters from user
-        ierr=1
-	do while (ierr.ne.0)
-          write(*,*) "Coefficient to apply to MONS 'depth' in Northern",
-     &               " Hemisphere?"
-          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
-          read(*,*,iostat=ierr) MONS_coeffN
-        enddo
-        ierr=1
-	do while (ierr.ne.0)
-          write(*,*) "Coefficient to apply to MONS 'depth' in Southern",
-     &               " Hemisphere?"
-          write(*,*) " (should be somewhere between 3.2e-4 and 1.3e-3)"
-          read(*,*,iostat=ierr) MONS_coeffS
-        enddo
-        ierr=1
-        do while (ierr.ne.0)
-          write(*,*) "Value of subterranean ice thermal inertia ",
-     &               " in Northern hemisphere?"
-          write(*,*) " (e.g.: 2000, or perhaps 2290)"
-!          read(*,*,iostat=ierr) iceith
-          read(*,*,iostat=ierr) iceithN
-        enddo
-        ierr=1
-        do while (ierr.ne.0)
-          write(*,*) "Value of subterranean ice thermal inertia ",
-     &               " in Southern hemisphere?"
-          write(*,*) " (e.g.: 2000, or perhaps 2290)"
-!          read(*,*,iostat=ierr) iceith
-          read(*,*,iostat=ierr) iceithS
-        enddo
-        
-        ! 3. Build subterranean thermal inertia
-        
-        ! initialise subsurface inertia with reference surface values
-        do isoil=1,nsoilmx
-          ithfi(1:ngridmx,isoil)=surfithfi(1:ngridmx)
-        enddo
-        ! recast ithfi() onto ith()
-	call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,ithfi,ith)
-        
-        do i=1,iip1 ! loop on longitudes
-          do j=1,jjp1 ! loop on latitudes
-            ! set MONS_coeff
-            if (rlatu(j).ge.0) then ! northern hemisphere
-              ! N.B: rlatu(:) contains decreasing values of latitude
-	      !       starting from PI/2 to -PI/2
-              MONS_coeff=MONS_coeffN
-              iceith=iceithN
-            else ! southern hemisphere
-              MONS_coeff=MONS_coeffS
-              iceith=iceithS
-            endif
-            ! check if we should put subterranean ice
-            if (MONS_Hdn(i,j).ge.14.0) then ! no ice if Hdn<14%
-              ! compute depth at which ice lies:
-              val=MONS_d21(i,j)*MONS_coeff
-              ! compute val2= the diurnal skin depth of surface inertia
-              ! assuming a volumetric heat cap. of C=1.e6 J.m-3.K-1
-              val2=ith(i,j,1)*1.e-6*sqrt(88775./3.14159)
-              if (val.lt.val2) then
-                ! ice must be below the (surface inertia) diurnal skin depth
-                val=val2
-              endif
-              if (val.lt.layer(nsoilmx)) then ! subterranean ice
-                ! find the reference index iref that depth corresponds to
-                iref=0
-                do isoil=1,nsoilmx-1
-                 if ((val.ge.layer(isoil)).and.(val.lt.layer(isoil+1)))
-     &             then
-	           iref=isoil
-	           exit
-	         endif
-                enddo
-                ! Build "equivalent" thermal inertia for the mixed layer
-                ith(i,j,iref+1)=sqrt((layer(iref+1)-layer(iref))/
-     &                     (((val-layer(iref))/(ith(i,j,iref+1)**2))+
-     &                      ((layer(iref+1)-val)/(iceith)**2)))
-	        ! Set thermal inertia of lower layers
-                do isoil=iref+2,nsoilmx
-                  ith(i,j,isoil)=iceith 
-                enddo
-              endif ! of if (val.lt.layer(nsoilmx))
-            endif ! of if (MONS_Hdn(i,j).lt.14.0)
-          enddo ! do j=1,jjp1
-        enddo ! do i=1,iip1
-        
-! Check:
-!         do i=1,iip1
-!           do j=1,jjp1
-!             do isoil=1,nsoilmx
-!               write(77,*) i,j,isoil,"  ",ith(i,j,isoil)
-!             enddo
-!           enddo
-!	 enddo
-
-        ! recast ith() into ithfi()
-        CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
-        
-	else
-          write(*,*) '       Unknown (misspelled?) option!!!'
-        end if ! of if (trim(modif) .eq. '...') elseif ...
-	
-       enddo ! of do ! infinite loop on liste of changes
-
- 999  continue
-
- 
-c=======================================================================
-c   Correct pressure on the new grid (menu 0)
-c=======================================================================
-
-      if (choix_1.eq.0) then
-        r = 1000.*8.31/mugaz
-
-        do j=1,jjp1
-          do i=1,iip1
-             ps(i,j) = ps(i,j) * 
-     .            exp((phisold_newgrid(i,j)-phis(i,j)) /
-     .                                  (t(i,j,1) * r))
-          end do
-        end do
-  
-c periodicity of surface ps in longitude
-        do j=1,jjp1
-          ps(1,j) = ps(iip1,j)
-        end do
-      end if
-
-c=======================================================================
-c=======================================================================
-
-c=======================================================================
-c    Initialisation de la physique / ecriture de newstartfi :
-c=======================================================================
-
-
-      CALL inifilr 
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-
-c-----------------------------------------------------------------------
-c   Initialisation  pks:
-c-----------------------------------------------------------------------
-
-      CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-! Calcul de la temperature potentielle teta
-
-      if (flagiso) then
-          DO l=1,llm
-             DO j=1,jjp1
-                DO i=1,iim
-                   teta(i,j,l) = Tiso * cpp/pk(i,j,l)
-                ENDDO
-                teta (iip1,j,l)= teta (1,j,l)
-             ENDDO
-          ENDDO
-      else if (choix_1.eq.0) then
-         DO l=1,llm
-            DO j=1,jjp1
-               DO i=1,iim
-                  teta(i,j,l) = t(i,j,l) * cpp/pk(i,j,l)
-               ENDDO
-               teta (iip1,j,l)= teta (1,j,l)
-            ENDDO
-         ENDDO
-      endif
-
-C Calcul intermediaire
-c
-      if (choix_1.eq.0) then
-         CALL massdair( p3d, masse  )
-c
-         print *,' ALPHAX ',alphax
-
-         DO  l = 1, llm
-           DO  i    = 1, iim
-             xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
-             xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
-           ENDDO
-             xpn      = SUM(xppn)/apoln
-             xps      = SUM(xpps)/apols
-           DO i   = 1, iip1
-             masse(   i   ,   1     ,  l )   = xpn
-             masse(   i   ,   jjp1  ,  l )   = xps
-           ENDDO
-         ENDDO
-      endif
-      phis(iip1,:) = phis(1,:)
-
-      CALL inidissip ( lstardis, nitergdiv, nitergrot, niterh,
-     *                tetagdiv, tetagrot , tetatemp  )
-      itau=0
-      if (choix_1.eq.0) then
-         day_ini=int(date)
-         hour_ini=date-int(date)
-      endif
-c
-      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
-
-      CALL caldyn0( itau,ucov,vcov,teta,ps,masse,pk,phis ,
-     *                phi,w, pbaru,pbarv,day_ini+time )
-c     CALL caldyn
-c    $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
-c    $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, day_ini )
-
-      CALL dynredem0("restart.nc",day_ini,anneeref,phis,nqtot)
-      CALL dynredem1("restart.nc",hour_ini,vcov,ucov,teta,q,
-     .               nqtot,masse,ps)
-C
-C Ecriture etat initial physique
-C
-
-      call physdem0("restartfi.nc",lonfi,latfi,nsoilmx,ngridmx,llm,
-     .              nqtot,dtphys,real(day_ini),0.0,
-     .              airefi,albfi,ithfi,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("restartfi.nc",nsoilmx,ngridmx,llm,nqtot,
-     .              dtphys,hour_ini,
-     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
-
-c=======================================================================
-c	Formats 
-c=======================================================================
-
-   1  FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dema
-     *rrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lllm =',i4,2x,'lue sur le fichier demar
-     *rage est differente de la valeur parametree llm =',i4//)
-
-      write(*,*) "newstart: All is well that ends well."
-
-      end
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      subroutine load_MONS_data(MONS_Hdn,MONS_d21)
-      implicit none
-      ! routine to load Benedicte Diez MONS dataset, fill in date in southern
-      ! polar region, and interpolate the result onto the GCM grid
-#include"dimensions.h"
-#include"paramet.h"
-#include"datafile.h"
-#include"comgeom.h"
-      ! arguments:
-      real,intent(out) :: MONS_Hdn(iip1,jjp1) ! Hdn: %WEH=Mass fraction of H2O
-      real,intent(out) :: MONS_d21(iip1,jjp1) ! ice table "depth" (in kg/m2)
-      ! N.B MONS datasets should be of dimension (iip1,jjp1)
-      ! local variables:
-      character(len=88) :: filename="results_MONS_lat_lon_H_depth.txt"
-      character(len=88) :: txt ! to store some text
-      integer :: ierr,i,j
-      integer,parameter :: nblon=180 ! number of longitudes of MONS datasets
-      integer,parameter :: nblat=90 ! number of latitudes of MONS datasets
-      real :: pi
-      real :: longitudes(nblon) ! MONS dataset longitudes
-      real :: latitudes(nblat)  ! MONS dataset latitudes
-      ! MONS dataset: mass fraction of H2O where H is assumed to be in H2O
-      real :: Hdn(nblon,nblat)
-      real :: d21(nblon,nblat)! MONS dataset "depth" (g/cm2)
-
-      ! Extended MONS dataset (for interp_horiz)
-      real :: Hdnx(nblon+1,nblat)
-      real :: d21x(nblon+1,nblat)
-      real :: lon_bound(nblon+1) ! longitude boundaries
-      real :: lat_bound(nblat-1) ! latitude boundaries
-
-      ! 1. Initializations:
-
-      write(*,*) "Loading MONS data"
-
-      ! Open MONS datafile:
-      open(42,file=trim(datafile)//"/"//trim(filename),
-     &     status="old",iostat=ierr)
-      if (ierr/=0) then
-        write(*,*) "Error in load_MONS_data:"
-        write(*,*) "Failed opening file ",
-     &             trim(datafile)//"/"//trim(filename)
-        write(*,*)'1) You can change the path to the file in '
-        write(*,*)'   file phymars/datafile.h'
-        write(*,*)'2) If necessary ',trim(filename),
-     &                 ' (and other datafiles)'
-        write(*,*)'   can be obtained online at:'
-        write(*,*)'http://www.lmd.jussieu.fr/~lmdz/planets/mars/datadir'
-        CALL ABORT
-      else ! skip first line of file (dummy read)
-         read(42,*) txt
-      endif
-
-      pi=2.*asin(1.)
-      
-      !2. Load MONS data (on MONS grid)
-      do j=1,nblat
-        do i=1,nblon
-        ! swap latitude index so latitudes go from north pole to south pole:
-          read(42,*) latitudes(nblat-j+1),longitudes(i),
-     &               Hdn(i,nblat-j+1),d21(i,nblat-j+1)
-        ! multiply d21 by 10 to convert from g/cm2 to kg/m2
-          d21(i,nblat-j+1)=d21(i,nblat-j+1)*10.0
-        enddo
-      enddo
-      close(42)
-      
-      ! there is unfortunately no d21 data for latitudes -77 to -90
-      ! so we build some by linear interpolation between values at -75
-      ! and assuming d21=0 at the pole
-      do j=84,90 ! latitudes(84)=-77 ; latitudes(83)=-75
-        do i=1,nblon
-          d21(i,j)=d21(i,83)*((latitudes(j)+90)/15.0)
-        enddo
-      enddo
-
-      ! 3. Build extended MONS dataset & boundaries (for interp_horiz)
-      ! longitude boundaries (in radians):
-      do i=1,nblon
-        ! NB: MONS data is every 2 degrees in longitude
-        lon_bound(i)=(longitudes(i)+1.0)*pi/180.0
-      enddo
-      ! extra 'modulo' value
-      lon_bound(nblon+1)=lon_bound(1)+2.0*pi
-      
-      ! latitude boundaries (in radians):
-      do j=1,nblat-1
-        ! NB: Mons data is every 2 degrees in latitude
-        lat_bound(j)=(latitudes(j)-1.0)*pi/180.0
-      enddo
-      
-      ! MONS datasets:
-      do j=1,nblat
-        Hdnx(1:nblon,j)=Hdn(1:nblon,j)
-        Hdnx(nblon+1,j)=Hdnx(1,j)
-        d21x(1:nblon,j)=d21(1:nblon,j)
-        d21x(nblon+1,j)=d21x(1,j)
-      enddo
-      
-      ! Interpolate onto GCM grid
-      call interp_horiz(Hdnx,MONS_Hdn,nblon,nblat-1,iim,jjm,1,
-     &                  lon_bound,lat_bound,rlonu,rlatv)
-      call interp_horiz(d21x,MONS_d21,nblon,nblat-1,iim,jjm,1,
-     &                  lon_bound,lat_bound,rlonu,rlatv)
-      
-      end subroutine
Index: trunk/LMDZ.MARS/libf/phymars/start2archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/start2archive.F	(revision 1399)
+++ 	(revision )
@@ -1,412 +1,0 @@
-c=======================================================================
-      PROGRAM start2archive
-c=======================================================================
-c
-c
-c   Date:    01/1997
-c   ----
-c
-c
-c   Objet:   Passage des  fichiers netcdf d'etat initial "start" et
-c   -----    "startfi" a un fichier netcdf unique "start_archive" 
-c
-c  "start_archive" est une banque d'etats initiaux:
-c  On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive"
-c    (Veiller dans ce cas avoir un day_ini different pour chacun des start)
-c 
-c
-c
-c=======================================================================
-
-      use infotrac, only: iniadvtrac, nqtot, tname
-      use comsoil_h, only: nsoilmx, inertiedat
-      use surfdat_h, only: ini_surfdat_h, qsurf
-      use comsoil_h, only: ini_comsoil_h
-      use comgeomphy, only: initcomgeomphy
-      implicit none
-
-#include "dimensions.h"
-      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) 
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "temps.h"
-#include "ener.h"
-#include "description.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c   Declarations
-c-----------------------------------------------------------------------
-
-c variables dynamiques du GCM
-c -----------------------------
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
-      REAL,ALLOCATABLE :: q(:,:,:)   ! champs advectes
-      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
-      REAL pk(ip1jmp1,llm)
-      REAL pkf(ip1jmp1,llm)
-      REAL beta(iip1,jjp1,llm)
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
-      REAL ps(ip1jmp1)                       ! pression au sol
-      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
-      
-c Variable Physiques (grille physique)
-c ------------------------------------
-      REAL tsurf(ngridmx)	! Surface temperature
-      REAL tsoil(ngridmx,nsoilmx) ! Soil temperature
-      REAL co2ice(ngridmx)	! CO2 ice layer
-      REAL tauscaling(ngridmx) ! dust conversion factor
-      REAL q2(ngridmx,llm+1)
-      REAL emis(ngridmx)
-      INTEGER start,length
-      PARAMETER (length = 100)
-      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
-      INTEGER*4 day_ini_fi
-
-c Variable naturelle / grille scalaire
-c ------------------------------------
-      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
-      REAL tsurfS(ip1jmp1)
-      REAL tsoilS(ip1jmp1,nsoilmx)
-      REAL ithS(ip1jmp1,nsoilmx) ! Soil Thermal Inertia
-      REAL co2iceS(ip1jmp1)
-      REAL tauscalingS(ip1jmp1)
-      REAL q2S(ip1jmp1,llm+1)
-      REAL,ALLOCATABLE :: qsurfS(:,:)
-      REAL emisS(ip1jmp1)
-
-c Variables intermediaires : vent naturel, mais pas coord scalaire
-c----------------------------------------------------------------
-      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
-
-c Autres  variables
-c -----------------
-      LOGICAL startdrs
-      INTEGER Lmodif
-
-      REAL ptotal, co2icetotal
-      REAL timedyn,timefi !fraction du jour dans start, startfi
-      REAL date
-
-      CHARACTER*2 str2
-      CHARACTER*80 fichier 
-      data  fichier /'startfi'/
-
-      INTEGER ij, l,i,j,isoil,iq
-      character*80      fichnom
-      integer :: ierr,ntime
-      integer :: nq,numvanle
-      character(len=30) :: txt ! to store some text
-
-c Netcdf
-c-------
-      integer varid,dimid,timelen 
-      INTEGER nid,nid1
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .TRUE. )
-      grireg   = .TRUE.
-! initialize "serial/parallel" related stuff
-      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-c=======================================================================
-c Lecture des donnees
-c=======================================================================
-! Load tracer number and names:
-      call iniadvtrac(nqtot,numvanle)
-
-! allocate arrays:
-      allocate(q(ip1jmp1,llm,nqtot))
-      allocate(qsurfS(ip1jmp1,nqtot))
-      call ini_surfdat_h(ngridmx,nqtot)
-      call ini_comsoil_h(ngridmx)
-      
-
-      fichnom = 'start.nc'
-      CALL dynetat0(fichnom,nqtot,vcov,ucov,teta,q,masse,
-     .       ps,phis,timedyn)
-
-
-      fichnom = 'startfi.nc'
-      Lmodif=0
-
-      CALL phyetat0 (fichnom,0,Lmodif,nsoilmx,ngridmx,llm,nqtot,
-     &      day_ini_fi,timefi,tsurf,tsoil,emis,q2,qsurf,co2ice,
-     &      tauscaling)
-
-       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid1)
-       IF (ierr.NE.NF_NOERR) THEN
-         write(6,*)' Pb d''ouverture du fichier'//fichnom
-        CALL ABORT
-       ENDIF
-                                                
-      ierr = NF_INQ_VARID (nid1, "controle", varid)
-      IF (ierr .NE. NF_NOERR) THEN
-       PRINT*, "start2archive: Le champ <controle> est absent"
-       CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-       ierr = NF_GET_VAR_DOUBLE(nid1, varid, tab_cntrl_fi)
-#else
-      ierr = NF_GET_VAR_REAL(nid1, varid, tab_cntrl_fi)
-#endif
-       IF (ierr .NE. NF_NOERR) THEN
-          PRINT*, "start2archive: Lecture echoue pour <controle>"
-          CALL abort
-       ENDIF
-
-      ierr = NF_CLOSE(nid1)
-
-c-----------------------------------------------------------------------
-c Controle de la synchro
-c-----------------------------------------------------------------------
-!mars a voir      if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) 
-      if ((day_ini_fi.ne.day_ini)) 
-     &  stop ' Probleme de Synchro entre start et startfi !!!'
-
-
-c *****************************************************************
-c    Option : Reinitialisation des dates dans la premieres annees :
-       do while (day_ini.ge.669)
-          day_ini=day_ini-669
-       enddo
-c *****************************************************************
-
-c-----------------------------------------------------------------------
-c   Initialisations 
-c-----------------------------------------------------------------------
-
-      CALL defrun_new(99, .FALSE. )
-      call iniconst
-      call inigeom
-      call inifilr
-      CALL pression(ip1jmp1, ap, bp, ps, p3d)
-      call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
-
-c=======================================================================
-c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
-c=======================================================================
-c  Les variables modeles dependent de la resolution. Il faut donc
-c  eliminer les facteurs responsables de cette dependance
-c  (pour utiliser newstart)
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c Vent   (depend de la resolution horizontale) 
-c-----------------------------------------------------------------------
-c
-c ucov --> un  et  vcov --> vn
-c un --> us  et   vn --> vs
-c
-c-----------------------------------------------------------------------
-
-      call covnat(llm,ucov, vcov, un, vn) 
-      call wind_scal(un,vn,us,vs) 
-
-c-----------------------------------------------------------------------
-c Temperature  (depend de la resolution verticale => de "sigma.def")
-c-----------------------------------------------------------------------
-c
-c h --> T
-c
-c-----------------------------------------------------------------------
-
-      DO l=1,llm
-         DO ij=1,ip1jmp1
-            T(ij,l)=teta(ij,l)*pk(ij,l)/cpp !mars deduit de l'equation dans newstart
-         ENDDO
-      ENDDO
-
-c-----------------------------------------------------------------------
-c Variable physique 
-c-----------------------------------------------------------------------
-c
-c tsurf --> tsurfS
-c co2ice --> co2iceS
-c tsoil --> tsoilS
-c emis --> emisS
-c q2 --> q2S
-c qsurf --> qsurfS
-c tauscaling --> tauscalingS
-c
-c-----------------------------------------------------------------------
-
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS)
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
-      ! Note: thermal inertia "inertiedat" is in comsoil.h
-      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,inertiedat,ithS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS)
-      call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S)
-      call gr_fi_dyn(nqtot,ngridmx,iip1,jjp1,qsurf,qsurfS)
-      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tauscaling,tauscalingS)
-
-c=======================================================================
-c Info pour controler
-c=======================================================================
-
-      ptotal =  0.
-      co2icetotal = 0.
-      DO j=1,jjp1
-         DO i=1,iim
-           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
-           co2icetotal = co2icetotal + 
-     &            co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1))
-         ENDDO
-      ENDDO
-      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
-      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
-
-c-----------------------------------------------------------------------
-c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi
-c-----------------------------------------------------------------------
-
-      tab_cntrl_fi(49) = ptotal
-      tab_cntrl_fi(50) = co2icetotal
-
-c=======================================================================
-c Ecriture dans le fichier  "start_archive"
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c Ouverture de "start_archive" 
-c-----------------------------------------------------------------------
-
-      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
- 
-c-----------------------------------------------------------------------
-c  si "start_archive" n'existe pas:
-c    1_ ouverture
-c    2_ creation de l'entete dynamique ("ini_archive")
-c-----------------------------------------------------------------------
-c ini_archive:
-c On met dans l'entete le tab_cntrl dynamique (1 a 16) 
-c  On y ajoute les valeurs du tab_cntrl_fi (a partir de 51)
-c  En plus les deux valeurs ptotal et co2icetotal (99 et 100)
-c-----------------------------------------------------------------------
-
-      if (ierr.ne.NF_NOERR) then
-         write(*,*)'OK, Could not open file "start_archive.nc"'
-         write(*,*)'So let s create a new "start_archive"'
-         ierr = NF_CREATE('start_archive.nc', 
-     &  IOR(NF_CLOBBER,NF_64BIT_OFFSET), nid)
-         call ini_archive(nid,day_ini,phis,ithS,tab_cntrl_fi)
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture de la coordonnee temps (date en jours)
-c-----------------------------------------------------------------------
-
-      date = day_ini + hour_ini
-      ierr= NF_INQ_VARID(nid,"Time",varid)
-      ierr= NF_INQ_DIMID(nid,"Time",dimid)
-      ierr= NF_INQ_DIMLEN(nid,dimid,timelen)
-      ntime=timelen+1
-
-      write(*,*) "******************"
-      write(*,*) "ntime",ntime
-      write(*,*) "******************"
-#ifdef NC_DOUBLE
-      ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
-#else
-      ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
-#endif
-      if (ierr.ne.NF_NOERR) then
-         write(*,*) "time matter ",NF_STRERROR(ierr)
-         stop
-      endif
-
-c-----------------------------------------------------------------------
-c Ecriture des champs  (co2ice,emis,ps,Tsurf,T,u,v,q2,q,qsurf)
-c-----------------------------------------------------------------------
-c ATTENTION: q2 a une couche de plus!!!!
-c    Pour creer un fichier netcdf lisible par grads,
-c    On passe donc une des couches de q2 a part
-c    comme une variable 2D (la couche au sol: "q2surf")
-c    Les lmm autres couches sont nommees "q2atm" (3D) 
-c-----------------------------------------------------------------------
-
-      call write_archive(nid,ntime,'co2ice','couche de glace co2',
-     &  'kg/m2',2,co2iceS)
-      call write_archive(nid,ntime,'tauscaling',
-     &  'dust conversion factor',' ',2,tauscalingS)
-      call write_archive(nid,ntime,'emis','grd emis',' ',2,emisS)
-      call write_archive(nid,ntime,'ps','Psurf','Pa',2,ps)
-      call write_archive(nid,ntime,'tsurf','surf T','K',2,tsurfS)
-      call write_archive(nid,ntime,'temp','temperature','K',3,t)
-      call write_archive(nid,ntime,'u','Vent zonal','m.s-1',3,us)
-      call write_archive(nid,ntime,'v','Vent merid','m.s-1',3,vs)
-      call write_archive(nid,ntime,'q2surf','wind variance','m2.s-2',2,
-     .              q2S)
-      call write_archive(nid,ntime,'q2atm','wind variance','m2.s-2',3,
-     .              q2S(1,2))
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  q  ( q[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-c       write(str2,'(i2.2)') iq
-c        call write_archive(nid,ntime,'q'//str2,'tracer','kg/kg',
-c     .         3,q(1,1,iq))
-        call write_archive(nid,ntime,tname(iq),'tracer','kg/kg',
-     &         3,q(1,1,iq))
-      end do
-c-----------------------------------------------------------------------
-c Ecriture du champs  qsurf  ( qsurf[1,nqtot] )
-c-----------------------------------------------------------------------
-      do iq=1,nqtot
-c       write(str2,'(i2.2)') iq
-c       call write_archive(nid,ntime,'qsurf'//str2,'Tracer on surface',
-c     $  'kg.m-2',2,qsurfS(1,iq))
-        txt=trim(tname(iq))//"_surf"
-        call write_archive(nid,ntime,txt,'Tracer on surface',
-     &  'kg.m-2',2,qsurfS(1,iq))
-      enddo
-
-
-c-----------------------------------------------------------------------
-c Ecriture du champs  tsoil  ( Tg[1,10] )
-c-----------------------------------------------------------------------
-c "tsoil" Temperature au sol definie dans 10 couches dans le sol
-c   Les 10 couches sont lues comme 10 champs 
-c  nommees Tg[1,10]
-
-c      do isoil=1,nsoilmx
-c       write(str2,'(i2.2)') isoil
-c       call write_archive(nid,ntime,'Tg'//str2,'Ground Temperature ',
-c     .   'K',2,tsoilS(1,isoil))
-c      enddo
-
-! Write soil temperatures tsoil
-      call write_archive(nid,ntime,'tsoil','Soil temperature',
-     &     'K',-3,tsoilS)
-
-! Write soil thermal inertia
-      call write_archive(nid,ntime,'inertiedat',
-     &     'Soil thermal inertia',
-     &     'J.s-1/2.m-2.K-1',-3,ithS)
-
-! Write (0D) volumetric heat capacity (stored in comsoil.h)
-!      call write_archive(nid,ntime,'volcapa',
-!     &     'Soil volumetric heat capacity',
-!     &     'J.m-3.K-1',0,volcapa)
-! Note: no need to write volcapa, it is stored in "controle" table
-
-      ierr=NF_CLOSE(nid)
-c-----------------------------------------------------------------------
-c Fin 
-c-----------------------------------------------------------------------
-
-      write(*,*) "startarchive: all is well that ends well"
-      
-      end 
Index: trunk/LMDZ.MARS/libf/phymars/testphys1d.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/testphys1d.F	(revision 1399)
+++ 	(revision )
@@ -1,830 +1,0 @@
-
-      PROGRAM testphys1d
-! to use  'getin'
-      USE ioipsl_getincom, only: getin
-      use infotrac, only: nqtot, tname
-      use comsoil_h, only: volcapa, layer, mlayer, inertiedat, nsoilmx
-      use comgeomfi_h, only: lati, long, area, sinlat, ini_fillgeom
-      use surfdat_h, only: albedodat, z0_default, emissiv, emisice,
-     &                     albedice, iceradius, dtemisice, z0,
-     &                     zmea, zstd, zsig, zgam, zthe, phisfi,
-     &                     watercaptag
-      use slope_mod, only: theta_sl, psi_sl
-      use control_mod, only: day_step
-      use phyredem, only: physdem0,physdem1
-      use comgeomphy, only: initcomgeomphy
-      use planete_h, only: year_day, periheli, aphelie, peri_day,
-     &                     obliquit, emin_turb, lmixmin
-      use comcstfi_h, only: pi, rad, daysec, omeg, g, mugaz, rcp, r,
-     &                      cpp, dtphys
-      use dimradmars_mod, only: tauscaling,tauvis
-      IMPLICIT NONE
-
-c=======================================================================
-c   subject:
-c   --------
-c   PROGRAM useful to run physical part of the martian GCM in a 1D column
-c       
-c Can be compiled with a command like (e.g. for 25 layers)
-c  "makegcm -p mars -d 25 testphys1d"
-c It requires the files "testphys1d.def" "callphys.def"
-c   and a 'run.def' file (containing a "INCLUDEDEF=callphys.def" line)
-c      and a file describing the sigma layers (e.g. "z2sig.def")
-c
-c   author: Frederic Hourdin, R.Fournier,F.Forget
-c   -------
-c   
-c   update: 12/06/2003 including chemistry (S. Lebonnois) 
-c                            and water ice (F. Montmessin)
-c 
-c=======================================================================
-
-#include "dimensions.h"
-      integer, parameter :: ngrid = 1 !(2+(jjm-1)*iim - 1/jjm)
-      integer, parameter :: nlayer = llm
-!#include "dimradmars.h"
-!#include "comgeomfi.h"
-!#include "surfdat.h"
-!#include "slope.h"
-!#include "comsoil.h"
-!#include "comdiurn.h"
-#include "callkeys.h"
-!#include "comsaison.h"
-!#include "control.h"
-#include "comvert.h"
-#include "netcdf.inc"
-#include "comg1d.h"
-#include "logic.h"
-!#include "advtrac.h"
-
-c --------------------------------------------------------------
-c  Declarations
-c --------------------------------------------------------------
-c
-      INTEGER unitstart      ! unite d'ecriture de "startfi"
-      INTEGER nlevel,nsoil,ndt
-      INTEGER ilayer,ilevel,isoil,idt,iq
-      LOGICAl firstcall,lastcall
-c
-      real,parameter :: odpref=610. ! DOD reference pressure (Pa)
-c
-      INTEGER day0          ! date initial (sol ; =0 a Ls=0)
-      REAL day           ! date durant le run
-      REAL time             ! time (0<time<1 ; time=0.5 a midi)
-      REAL play(nlayer)   ! Pressure at the middle of the layers (Pa)
-      REAL plev(nlayer+1) ! intermediate pressure levels (pa)
-      REAL psurf,tsurf(1)      
-      REAL u(nlayer),v(nlayer)  ! zonal, meridional wind
-      REAL gru,grv   ! prescribed "geostrophic" background wind
-      REAL temp(nlayer)   ! temperature at the middle of the layers
-      REAL,ALLOCATABLE :: q(:,:) ! tracer mixing ratio (e.g. kg/kg)
-      REAL,ALLOCATABLE :: qsurf(:) ! tracer surface budget (e.g. kg.m-2)
-      REAL tsoil(nsoilmx)   ! subsurface soik temperature (K)
-      REAL co2ice(1)        ! co2ice layer (kg.m-2)
-      REAL emis(1)          ! surface layer
-      REAL q2(nlayer+1)   ! Turbulent Kinetic Energy
-      REAL zlay(nlayer)   ! altitude estimee dans les couches (km)
-
-c    Physical and dynamical tandencies (e.g.  m.s-2, K/s, Pa/s)
-      REAL du(nlayer),dv(nlayer),dtemp(nlayer)
-      REAL dudyn(nlayer),dvdyn(nlayer),dtempdyn(nlayer)
-      REAL dpsurf    
-      REAL,ALLOCATABLE :: dq(:,:)
-      REAL,ALLOCATABLE :: dqdyn(:,:)
-
-c   Various intermediate variables
-      INTEGER thermo
-      REAL zls
-      REAL phi(nlayer),h(nlayer),s(nlayer)
-      REAL pks, ptif, w(nlayer)
-      REAL qtotinit,qtot
-      real,allocatable :: mqtot(:)
-      INTEGER ierr, aslun
-      REAL tmp1(0:nlayer),tmp2(0:nlayer)
-      Logical  tracerdyn
-      integer :: nq=1 ! number of tracers
-      real :: latitude(1), longitude(1)
-
-      character*2 str2
-      character (len=7) :: str7
-      character(len=44) :: txt
-
-c=======================================================================
-
-c=======================================================================
-c INITIALISATION
-c=======================================================================
-! initialize "serial/parallel" related stuff
-!      CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
-      call initcomgeomphy
-
-c ------------------------------------------------------
-c  Prescribed constants to be set here
-c ------------------------------------------------------
-
-      pi=2.E+0*asin(1.E+0)
-
-c     Mars planetary constants
-c     ----------------------------
-      rad=3397200.               ! mars radius (m)  ~3397200 m
-      daysec=88775.              ! length of a sol (s)  ~88775 s
-      omeg=4.*asin(1.)/(daysec)  ! rotation rate (rad.s-1)
-      g=3.72                     ! gravity (m.s-2) ~3.72  
-      mugaz=43.49                ! atmosphere mola mass (g.mol-1) ~43.49
-      rcp=.256793                ! = r/cp  ~0.256793
-      r= 8.314511E+0 *1000.E+0/mugaz
-      cpp= r/rcp
-      year_day = 669             ! lenght of year (sols) ~668.6
-      periheli = 206.66          ! minimum sun-mars distance (Mkm) ~206.66
-      aphelie = 249.22           ! maximum sun-mars distance (Mkm) ~249.22
-      peri_day =  485.           ! perihelion date (sols since N. Spring)
-      obliquit = 25.2            ! Obliquity (deg) ~25.2         
- 
-c     Planetary Boundary Layer and Turbulence parameters 
-c     --------------------------------------------------
-      z0_default =  1.e-2        ! surface roughness (m) ~0.01 
-      emin_turb = 1.e-6          ! minimal turbulent energy ~1.e-8
-      lmixmin = 30               ! mixing length ~100
- 
-c     cap properties and surface emissivities
-c     ----------------------------------------------------
-      emissiv= 0.95              ! Bare ground emissivity ~.95
-      emisice(1)=0.95            ! Northern cap emissivity
-      emisice(2)=0.95            ! Southern cap emisssivity
-      albedice(1)=0.5            ! Northern cap albedo
-      albedice(2)=0.5            ! Southern cap albedo
-      iceradius(1) = 100.e-6     ! mean scat radius of CO2 snow (north)
-      iceradius(2) = 100.e-6     ! mean scat radius of CO2 snow (south)
-      dtemisice(1) = 2.          ! time scale for snow metamorphism (north)
-      dtemisice(2) = 2.          ! time scale for snow metamorphism (south
-
-
-c ------------------------------------------------------
-c  Loading run parameters from "run.def" file
-c ------------------------------------------------------
-
-
-! check if 'run.def' file is around (otherwise reading parameters
-! from callphys.def via getin() routine won't work.
-      open(99,file='run.def',status='old',form='formatted',
-     &     iostat=ierr)
-      if (ierr.ne.0) then
-        write(*,*) 'Cannot find required file "run.def"'
-        write(*,*) '  (which should contain some input parameters'
-        write(*,*) '   along with the following line:'
-        write(*,*) '   INCLUDEDEF=callphys.def'
-        write(*,*) '   )'
-        write(*,*) ' ... might as well stop here ...'
-        stop
-      else
-        close(99)
-      endif
-
-! check if we are going to run with or without tracers
-      write(*,*) "Run with or without tracer transport ?"
-      tracer=.false. ! default value
-      call getin("tracer",tracer)
-      write(*,*) " tracer = ",tracer
-
-! while we're at it, check if there is a 'traceur.def' file
-! and process it.
-      if (tracer) then
-      ! load tracer names from file 'traceur.def'
-        open(90,file='traceur.def',status='old',form='formatted',
-     &       iostat=ierr)
-        if (ierr.ne.0) then
-          write(*,*) 'Cannot find required file "traceur.def"'
-          write(*,*) ' If you want to run with tracers, I need it'
-          write(*,*) ' ... might as well stop here ...'
-          stop
-        else
-          write(*,*) "testphys1d: Reading file traceur.def"
-          ! read number of tracers:
-          read(90,*,iostat=ierr) nq
-          nqtot=nq ! set value of nqtot (in infotrac module) as nq
-          if (ierr.ne.0) then
-            write(*,*) "testphys1d: error reading number of tracers"
-            write(*,*) "   (first line of traceur.def) "
-            stop
-          endif
-        endif
-        ! allocate arrays:
-        allocate(tname(nq))
-        allocate(q(nlayer,nq))
-        allocate(qsurf(nq))
-        allocate(dq(nlayer,nq))
-        allocate(dqdyn(nlayer,nq))
-        allocate(mqtot(nq))
-        
-        ! read tracer names from file traceur.def
-        do iq=1,nq
-          read(90,*,iostat=ierr) tname(iq)
-          if (ierr.ne.0) then
-            write(*,*) 'testphys1d: error reading tracer names...'
-            stop
-          endif
-        enddo
-        close(90)
-
-        ! initialize tracers here:
-        write(*,*) "testphys1d: initializing tracers"
-        q(:,:)=0 ! default, set everything to zero
-        qsurf(:)=0
-        ! "smarter" initialization of some tracers
-        ! (get values from "profile_*" files, if these are available)
-        do iq=1,nq
-          txt=""
-          write(txt,"(a)") tname(iq)
-          write(*,*)"  tracer:",trim(txt)
-          ! CO2
-          if (txt.eq."co2") then
-            q(:,iq)=0.95   ! kg /kg of atmosphere
-            qsurf(iq)=0. ! kg/m2 (not used for CO2)
-            ! even better, look for a "profile_co2" input file
-            open(91,file='profile_co2',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            endif
-            close(91)
-          endif ! of if (txt.eq."co2")
-          ! Allow for an initial profile of argon
-          ! Can also be used to introduce a decaying tracer
-          ! in the 1D (TBD) to study thermals
-          if (txt.eq."ar") then
-            !look for a "profile_ar" input file
-            open(91,file='profile_ar',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ar file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ar")
-
-          ! WATER VAPOUR
-          if (txt.eq."h2o_vap") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_vap',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_vap file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! WATER ICE
-          if (txt.eq."h2o_ice") then
-            !look for a "profile_h2o_vap" input file
-            open(91,file='profile_h2o_ice',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_h2o_ice file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."h2o_ice")
-          ! DUST
-          !if (txt(1:4).eq."dust") then
-          !  q(:,iq)=0.4    ! kg/kg of atmosphere
-          !  qsurf(iq)=100 ! kg/m2
-          !endif
-          ! DUST MMR
-          if (txt.eq."dust_mass") then
-            !look for a "profile_dust_mass" input file
-            open(91,file='profile_dust_mass',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-!                write(*,*) "l=",ilayer," q(ilayer,iq)=",q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_mass file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_mass")
-          ! DUST NUMBER
-          if (txt.eq."dust_number") then
-            !look for a "profile_dust_number" input file
-            open(91,file='profile_dust_number',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_dust_number file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."dust_number")
-          ! NB: some more initializations (chemistry) is done later
-          ! CCN MASS
-          if (txt.eq."ccn_mass") then
-            !look for a "profile_ccn_mass" input file
-            open(91,file='profile_ccn_mass',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ccn_mass file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ccn_mass")
-          ! CCN NUMBER
-          if (txt.eq."ccn_number") then
-            !look for a "profile_ccn_number" input file
-            open(91,file='profile_ccn_number',status='old',
-     &       form='formatted',iostat=ierr)
-            if (ierr.eq.0) then
-              read(91,*) qsurf(iq)
-              do ilayer=1,nlayer
-                read(91,*) q(ilayer,iq)
-              enddo
-            else
-              write(*,*) "No profile_ccn_number file!"
-            endif
-            close(91)
-          endif ! of if (txt.eq."ccn_number")
-        enddo ! of do iq=1,nq
-
-      else
-      ! we still need to set (dummy) tracer number and names for physdem1
-        nq=1
-        nqtot=nq ! set value of nqtot (in infotrac module) as nq
-        ! allocate arrays:
-        allocate(tname(nq))
-        allocate(q(nlayer,nq))
-        allocate(qsurf(nq))
-        allocate(dq(nlayer,nq))
-        allocate(dqdyn(nlayer,nq))
-        allocate(mqtot(nq))
-        do iq=1,nq
-          write(str7,'(a1,i2.2)')'t',iq
-          tname(iq)=str7
-        enddo
-      ! and just to be clean, also initialize tracers to zero for physdem1
-        q(:,:)=0 
-        qsurf(:)=0      
-      endif ! of if (tracer)
-      
-      !write(*,*) "testphys1d q", q(1,:)
-      !write(*,*) "testphys1d qsurf", qsurf
-
-c  Date and local time at beginning of run
-c  ---------------------------------------
-c    Date (in sols since spring solstice) at beginning of run
-      day0 = 0 ! default value for day0
-      write(*,*) 'Initial date (in martian sols ; =0 at Ls=0)?'
-      call getin("day0",day0)
-      day=float(day0)
-      write(*,*) " day0 = ",day0
-c  Local time at beginning of run 
-      time=0 ! default value for time
-      write(*,*)'Initial local time (in hours, between 0 and 24)?'
-      call getin("time",time)
-      write(*,*)" time = ",time
-      time=time/24.E+0 ! convert time (hours) to fraction of sol
-
-c  Discretization (Definition of grid and time steps)
-c  --------------
-c
-      nlevel=nlayer+1
-      nsoil=nsoilmx
-
-      day_step=48 ! default value for day_step
-      PRINT *,'Number of time steps per sol ?'
-      call getin("day_step",day_step)
-      write(*,*) " day_step = ",day_step
-
-      ndt=10 ! default value for ndt
-      PRINT *,'Number of sols to run ?'
-      call getin("ndt",ndt)
-      write(*,*) " ndt = ",ndt
-
-      ndt=ndt*day_step     
-      dtphys=daysec/day_step  
-
-c Imposed surface pressure
-c ------------------------------------
-c
-      psurf=610. ! default value for psurf
-      PRINT *,'Surface pressure (Pa) ?'
-      call getin("psurf",psurf)
-      write(*,*) " psurf = ",psurf
-c Reference pressures
-      pa=20.   ! transition pressure (for hybrid coord.)
-      preff=610.      ! reference surface pressure
- 
-c Aerosol properties
-c --------------------------------
-      tauvis=0.2 ! default value for tauvis (dust opacity)
-      write(*,'("Reference dust opacity at ",f4.0," Pa ?")')odpref
-      call getin("tauvis",tauvis)
-      write(*,*) " tauvis = ",tauvis
-
-c Orbital parameters
-c ------------------
-      print *,'Min. distance Sun-Mars (Mkm)?'
-      call getin("periheli",periheli)
-      write(*,*) " periheli = ",periheli
-
-      print *,'Max. distance Sun-Mars (Mkm)?'
-      call getin("aphelie",aphelie)
-      write(*,*) " aphelie = ",aphelie
-
-      print *,'Day of perihelion?'
-      call getin("periday",peri_day)
-      write(*,*) " periday = ",peri_day
-
-      print *,'Obliquity?'
-      call getin("obliquit",obliquit)
-      write(*,*) " obliquit = ",obliquit
- 
-c  latitude/longitude
-c  ------------------
-      latitude(1)=0 ! default value for latitude
-      PRINT *,'latitude (in degrees) ?'
-      call getin("latitude",latitude(1))
-      write(*,*) " latitude = ",latitude
-      latitude=latitude*pi/180.E+0
-      longitude=0.E+0
-      longitude=longitude*pi/180.E+0
-
-!  some initializations (some of which have already been
-!  done above!) and loads parameters set in callphys.def
-!  and allocates some arrays 
-!Mars possible matter with dtphys in input and include!!!
-      call phys_state_var_init(1,llm,nq,
-     .          daysec,dtphys,rad,g,r,cpp)
-      call ini_fillgeom(1,latitude,longitude,(/1.0/))
-      call conf_phys(1,llm,nq)
-
-
-c  Initialize albedo / soil thermal inertia
-c  ----------------------------------------
-c
-      albedodat(1)=0.2 ! default value for albedodat
-      PRINT *,'Albedo of bare ground ?'
-      call getin("albedo",albedodat(1))
-      write(*,*) " albedo = ",albedodat(1)
-
-      inertiedat(1,1)=400 ! default value for inertiedat
-      PRINT *,'Soil thermal inertia (SI) ?'
-      call getin("inertia",inertiedat(1,1))
-      write(*,*) " inertia = ",inertiedat(1,1)
-
-      z0(1)=z0_default ! default value for roughness
-      write(*,*) 'Surface roughness length z0 (m)?'
-      call getin("z0",z0(1))
-      write(*,*) " z0 = ",z0(1)
-
-! Initialize local slope parameters (only matters if "callslope"
-! is .true. in callphys.def)
-      ! slope inclination angle (deg) 0: horizontal, 90: vertical
-      theta_sl(1)=0.0 ! default: no inclination
-      call getin("slope_inclination",theta_sl(1))
-      ! slope orientation (deg)
-      ! 0 == Northward, 90 == Eastward, 180 == Southward, 270 == Westward
-      psi_sl(1)=0.0 ! default value
-      call getin("slope_orientation",psi_sl(1))
-      
-c
-c  for the gravity wave scheme
-c  ---------------------------------
-c
-      zmea(1)=0.E+0
-      zstd(1)=0.E+0
-      zsig(1)=0.E+0
-      zgam(1)=0.E+0
-      zthe(1)=0.E+0
-
-
-c   Specific initializations for "physiq"
-c   -------------------------------------
-c   mesh surface (not a very usefull quantity in 1D)
-      area(1)=1.E+0
-
-c   surface geopotential is not used (or useful) since in 1D
-c   everything is controled by surface pressure
-      phisfi(1)=0.E+0
-
-c   Initialization to take into account prescribed winds
-c   ------------------------------------------------------
-      ptif=2.E+0*omeg*sinlat(1)
- 
-c    geostrophic wind
-      gru=10. ! default value for gru
-      PRINT *,'zonal eastward component of the geostrophic wind (m/s) ?'
-      call getin("u",gru)
-      write(*,*) " u = ",gru
-      grv=0. !default value for grv
-      PRINT *,'meridional northward component of the geostrophic',
-     &' wind (m/s) ?'
-      call getin("v",grv)
-      write(*,*) " v = ",grv
-
-c     Initialize winds  for first time step
-      DO ilayer=1,nlayer
-         u(ilayer)=gru
-         v(ilayer)=grv
-      ENDDO
-
-c     Initialize turbulente kinetic energy
-      DO ilevel=1,nlevel
-         q2(ilevel)=0.E+0
-      ENDDO
-
-c  CO2 ice on the surface
-c  -------------------
-      co2ice(1)=0.E+0 ! default value for co2ice
-      PRINT *,'Initial CO2 ice on the surface (kg.m-2)'
-      call getin("co2ice",co2ice)
-      write(*,*) " co2ice = ",co2ice
-
-c
-c  emissivity
-c  ----------
-      emis=emissiv
-      IF (co2ice(1).eq.1.E+0) THEN
-         emis=emisice(1) ! northern hemisphere
-         IF(lati(1).LT.0) emis=emisice(2) ! southern hemisphere
-      ENDIF
-
- 
-
-c  Compute pressures and altitudes of atmospheric levels 
-c  ----------------------------------------------------------------
-
-c    Vertical Coordinates
-c    """"""""""""""""""""
-      hybrid=.true.
-      PRINT *,'Hybrid coordinates ?'
-      call getin("hybrid",hybrid)
-      write(*,*) " hybrid = ", hybrid
-
-      CALL  disvert
-
-      DO ilevel=1,nlevel
-        plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-      ENDDO
-
-      DO ilayer=1,nlayer
-        zlay(ilayer)=-200.E+0 *r*log(play(ilayer)/plev(1))
-     &   /g
-      ENDDO
-
-
-c  Initialize temperature profile
-c  --------------------------------------
-      pks=psurf**rcp
-
-c altitude in km in profile: divide zlay by 1000
-      tmp1(0)=0.E+0
-      DO ilayer=1,nlayer
-        tmp1(ilayer)=zlay(ilayer)/1000.E+0
-      ENDDO
-
-      call profile(nlayer+1,tmp1,tmp2)
-
-      tsurf=tmp2(0)
-      DO ilayer=1,nlayer
-        temp(ilayer)=tmp2(ilayer)
-      ENDDO
-      
-
-
-! Initialize soil properties and temperature
-! ------------------------------------------
-      volcapa=1.e6 ! volumetric heat capacity
-      DO isoil=1,nsoil
-         inertiedat(1,isoil)=inertiedat(1,1) ! soil thermal inertia
-         tsoil(isoil)=tsurf(1)  ! soil temperature
-      ENDDO
-
-! Initialize depths
-! -----------------
-      do isoil=0,nsoil-1
-        mlayer(isoil)=2.e-4*(2.**(isoil-0.5)) ! mid-layer depth
-      enddo
-      do isoil=1,nsoil
-        layer(isoil)=2.e-4*(2.**(isoil-1)) ! layer depth
-      enddo
-
-c    Initialize traceurs
-c    ---------------------------
-
-      if (photochem.or.callthermos) then
-         write(*,*) 'Initializing chemical species'
-         ! thermo=0: initialize over all atmospheric layers
-         thermo=0
-         call inichim_newstart(q,psurf,sig,nq,lati,long,area,
-     $   thermo,qsurf)
-      endif
-
-c Check if the surface is a water ice reservoir 
-c --------------------------------------------------
-      watercaptag(1)=.false. ! Default: no water ice reservoir
-      print *,'Water ice cap on ground ?'
-      call getin("watercaptag",watercaptag)
-      write(*,*) " watercaptag = ",watercaptag
-      
-
-c    Initialization for GRADS outputs in "g1d.dat" and "g1d.ctl"
-c    ----------------------------------------------------------------
-c    (output done in "writeg1d", typically called by "physiq.F")
-
-        g1d_nlayer=nlayer
-        g1d_nomfich='g1d.dat'
-        g1d_unitfich=40
-        g1d_nomctl='g1d.ctl'
-        g1d_unitctl=41
-        g1d_premier=.true.
-        g2d_premier=.true.
-
-c  Write a "startfi" file
-c  --------------------
-c  This file will be read during the first call to "physiq".
-c  It is needed to transfert physics variables to "physiq"...
-
-      call physdem0("startfi.nc",long,lati,nsoilmx,ngrid,llm,nq,
-     .              dtphys,float(day0),time,area,
-     .              albedodat,inertiedat,zmea,zstd,zsig,zgam,zthe)
-      call physdem1("startfi.nc",nsoilmx,ngrid,llm,nq,
-     .              dtphys,time,
-     .              tsurf,tsoil,co2ice,emis,q2,qsurf,tauscaling)
-
-c=======================================================================
-c  1D MODEL TIME STEPPING LOOP
-c=======================================================================
-c
-      firstcall=.true.
-      lastcall=.false.
-
-      DO idt=1,ndt
-c        IF (idt.eq.ndt) lastcall=.true.
-        IF (idt.eq.ndt-day_step-1) then       !test
-         lastcall=.true.
-         call solarlong(day*1.0,zls)
-         write(103,*) 'Ls=',zls*180./pi
-         write(103,*) 'Lat=', lati(1)*180./pi
-         write(103,*) 'Tau=', tauvis/odpref*psurf
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(103,*) 'RunEnd - Atmos. Temp. File'
-         write(104,*) 'Ls=',zls*180./pi
-         write(104,*) 'Lat=', lati(1)
-         write(104,*) 'Tau=', tauvis/odpref*psurf
-         write(104,*) 'RunEnd - Atmos. Temp. File'
-        ENDIF
-
-c     compute geopotential
-c     ~~~~~~~~~~~~~~~~~~~~~
-      DO ilayer=1,nlayer
-        s(ilayer)=(aps(ilayer)/psurf+bps(ilayer))**rcp
-        h(ilayer)=cpp*temp(ilayer)/(pks*s(ilayer))
-      ENDDO
-      phi(1)=pks*h(1)*(1.E+0-s(1))
-      DO ilayer=2,nlayer
-         phi(ilayer)=phi(ilayer-1)+
-     &               pks*(h(ilayer-1)+h(ilayer))*.5E+0
-     &                  *(s(ilayer-1)-s(ilayer))
-
-      ENDDO
-
-c       call physics
-c       --------------------
-!      write(*,*) "testphys1d avant q", q(1,:)
-      CALL physiq (1,llm,nq,
-     ,     firstcall,lastcall,
-     ,     day,time,dtphys,
-     ,     plev,play,phi,
-     ,     u, v,temp, q,  
-     ,     w,
-C - outputs
-     s     du, dv, dtemp, dq,dpsurf,tracerdyn)
-!      write(*,*) "testphys1d apres q", q(1,:)
-
-
-c       wind increment : specific for 1D
-c       --------------------------------
- 
-c       The physics compute the tendencies on u and v,
-c       here we just add Coriolos effect
-c
-c       DO ilayer=1,nlayer
-c          du(ilayer)=du(ilayer)+ptif*(v(ilayer)-grv)
-c          dv(ilayer)=dv(ilayer)+ptif*(-u(ilayer)+gru)
-c       ENDDO
-
-c       For some tests : No coriolis force at equator
-c       if(lati(1).eq.0.) then
-          DO ilayer=1,nlayer
-             du(ilayer)=du(ilayer)+ (gru-u(ilayer))/1.e4
-             dv(ilayer)=dv(ilayer)+ (grv-v(ilayer))/1.e4
-          ENDDO
-c       end if
-c      
-c
-c       Compute time for next time step
-c       ---------------------------------------
-        firstcall=.false.
-        time=time+dtphys/daysec
-        IF (time.gt.1.E+0) then
-            time=time-1.E+0
-            day=day+1
-        ENDIF
-
-c       compute winds and temperature for next time step
-c       ----------------------------------------------------------
-
-        DO ilayer=1,nlayer
-           u(ilayer)=u(ilayer)+dtphys*du(ilayer)
-           v(ilayer)=v(ilayer)+dtphys*dv(ilayer)
-           temp(ilayer)=temp(ilayer)+dtphys*dtemp(ilayer)
-        ENDDO
-
-c       compute pressure for next time step 
-c       ----------------------------------------------------------
-
-           psurf=psurf+dtphys*dpsurf   ! surface pressure change
-           DO ilevel=1,nlevel
-             plev(ilevel)=ap(ilevel)+psurf*bp(ilevel)
-           ENDDO
-           DO ilayer=1,nlayer
-             play(ilayer)=aps(ilayer)+psurf*bps(ilayer)
-           ENDDO
-
-!       increment tracers
-        DO iq = 1, nq
-          DO ilayer=1,nlayer
-             q(ilayer,iq)=q(ilayer,iq)+dtphys*dq(ilayer,iq)
-          ENDDO
-        ENDDO
-
-      ENDDO   ! of idt=1,ndt ! end of time stepping loop
-
-c    ========================================================
-c    OUTPUTS
-c    ========================================================
-
-c    finalize and close grads files "g1d.dat" and "g1d.ctl"
-
-c        CALL endg1d(1,nlayer,zphi/(g*1000.),ndt)
-        CALL endg1d(1,nlayer,zlay/1000.,ndt)
-
-      write(*,*) "testphys1d: Everything is cool."
-
-      END
- 
-c***********************************************************************
-c***********************************************************************
-c     Dummy subroutines used only in 3D, but required to
-c     compile testphys1d (to cleanly use writediagfi)
-
-      subroutine gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-
-      IMPLICIT NONE
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-      
-      if (ngrid.ne.1) then
-        write(*,*) "gr_fi_dyn error: in 1D ngrid should be 1!!!"
-        stop
-      endif
-      
-      pdyn(1,1,1:nfield)=pfi(1,1:nfield)
-      
-      end
- 
-c***********************************************************************
-c***********************************************************************
-
-#include "../dyn3d/disvert.F"
-#include "../dyn3d/abort_gcm.F"
Index: trunk/LMDZ.MARS/libf/phymars/write_archive.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/write_archive.F	(revision 1399)
+++ 	(revision )
@@ -1,252 +1,0 @@
-c=======================================================================
-      subroutine write_archive(nid,ntime,nom,titre,unite,dim,px)
-c=======================================================================
-c
-c
-c   Date:    01/1997
-c   ----
-c
-c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
-c   -----    dans un fichier DRS nomme "start_archive"
-c
-c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
-c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
-c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
-c    (ex: la longitude solaire)
-c
-c
-c   Arguments: 
-c   ----------
-c
-c     Inputs:
-c     ------
-c
-c		  nid      Unite logique du fichier "start_archive"
-c         nom      nom du champ a ecrire dans le fichier "start_archive"
-c         titre    titre de la variable dans le fichier DRS "start_archive"
-c         unite    unite de la variable ....
-c         dim      dimension de la variable a ecrire
-c         px       tableau contenant la variable a ecrire
-c
-c
-c=======================================================================
-
-      use comsoil_h, only: nsoilmx
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-!#include "control.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "description.h"
-#include "temps.h"
-#include "netcdf.inc"
-
-c-----------------------------------------------------------------------
-c	Declarations   
-c-----------------------------------------------------------------------
-
-c Arguments:
-
-      INTEGER nid
-      integer ntime ! time index
-      integer dim 
-      REAL px(iip1,jjp1,llm) 
-
-      CHARACTER*(*) nom, titre, unite
-
-      integer ierr
-
-
-c local
-      integer, dimension(4) :: edges,corner,id
-      integer :: varid,i,j,l
-c-----------------------------------------------------------------------
-c      Ecriture du champs dans le fichier            (3 cas)      
-c-----------------------------------------------------------------------
-
-! For an atmospheric 3D Variable
-!--------------------------------
-        if (dim.eq.3) then
-
-!         Ecriture du champs
-
-! nom de la variable
-           ierr= NF_INQ_VARID(nid,nom,varid)
-           if (ierr /= NF_NOERR) then
-! choix du nom des coordonnees
-              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
-              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
-              ierr= NF_INQ_DIMID(nid,"Time",id(4))
-
-! Creation de la variable si elle n'existait pas
-
-              write (*,*) "====================="
-              write (*,*) "creation de ",nom
-              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
-
-           endif
-
-! mars s'arranger pour qu'il n'y ai plus besoin de ca
-
-c          do l=1,llm
-c             do j=1,jjp1
-c                do i=1,iip1
-c                   pxbis(i,j,l)=px(i,j,llm-l+1)
-c                enddo
-c             enddo
-c          enddo
-           corner(1)=1
-           corner(2)=1
-           corner(3)=1
-           corner(4)=ntime
-
-           edges(1)=iip1
-           edges(2)=jjp1
-           edges(3)=llm
-           edges(4)=1
-#ifdef NC_DOUBLE
-           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
-#else
-           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
-#endif
-
-           if (ierr.ne.NF_NOERR) then
-              write(*,*) "***** PUT_VAR matter in write_archive"
-              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
-              call abort
-           endif
-
-
-! For a subterranean 3D Variable
-!-------------------------------
-
-        else if (dim.eq.-3) then
-	! get variables' ID, if it exists
-	ierr=NF_INQ_VARID(nid,nom,varid)
-	
-	 if (ierr.ne.NF_NOERR) then ! variable not defined yet
-	  ! build related coordinates
-	  ierr=NF_INQ_DIMID(nid,"longitude",id(1))
-	  ierr=NF_INQ_DIMID(nid,"latitude",id(2))
-	  ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
-	  if (ierr.ne.NF_NOERR) then
-	   write(*,*)"write_archive: dimension <subsurface_layers>",
-     &               " is missing !!!"
-	   call abort
-	  endif
-          ierr=NF_INQ_DIMID(nid,"Time",id(4))
-	  
-	  ! define the variable
-	  write(*,*)"====================="
-	  write(*,*)"defining ",nom
-	  call def_var(nid,nom,titre,unite,4,id,varid,ierr)
-	  
-	 endif
-
-        ! build cedges and corners
-        corner(1)=1
-        corner(2)=1
-        corner(3)=1
-        corner(4)=ntime
-
-        edges(1)=iip1
-        edges(2)=jjp1
-        edges(3)=nsoilmx
-        edges(4)=1
-#ifdef NC_DOUBLE
-           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
-#else
-           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
-#endif
-
-
-! For a surface 2D Variable
-!--------------------------
-
-        else if (dim.eq.2) then
-
-!         Ecriture du champs
-
-           ierr= NF_INQ_VARID(nid,nom,varid)
-           if (ierr /= NF_NOERR) then
-!  choix du nom des coordonnees
-              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
-              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
-              ierr= NF_INQ_DIMID(nid,"Time",id(3))
-
-! Creation de la variable si elle n'existait pas
-
-              write (*,*) "====================="
-              write (*,*) "creation de ",nom
-
-              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
-
-           endif
-
-           corner(1)=1
-           corner(2)=1
-           corner(3)=ntime
-           edges(1)=iip1
-           edges(2)=jjp1
-           edges(3)=1
-
-
-#ifdef NC_DOUBLE
-           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
-#else         
-           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
-#endif     
-
-           if (ierr.ne.NF_NOERR) then
-              write(*,*) "***** PUT_VAR matter in write_archive"
-              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
-              call abort
-           endif
-
-
-!Cas Variable 0D (scalaire dependant du temps)
-!---------------------------------------------
-
-        else if (dim.eq.0) then
-
-!         Ecriture du champs
-
-           ierr= NF_INQ_VARID(nid,nom,varid)
-           if (ierr /= NF_NOERR) then
-!  choix du nom des coordonnees
-              ierr= NF_INQ_DIMID(nid,"Time",id(1))
-
-! Creation de la variable si elle n'existait pas
-
-              write (*,*) "====================="
-              write (*,*) "creation de ",nom
-
-              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
-
-           endif
-
-           corner(1)=ntime
-           edges(1)=1
-
-#ifdef NC_DOUBLE
-           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
-#else
-           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
-#endif
-           if (ierr.ne.NF_NOERR) then
-              write(*,*) "***** PUT_VAR matter in write_archive"
-              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
-              call abort
-           endif
-
-        else
-	  write(*,*) "write_archive: dim=",dim," ?!?"
-	  call abort
-        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
-
-      return
-      end
-
Index: trunk/LMDZ.MARS/libf/phymars/xvik.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/xvik.F	(revision 1399)
+++ 	(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
