Index: LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: abort_gcm.F 1279 2009-12-10 09:02:56Z fairhead $
+! $Id: abort_gcm.F 1425 2010-09-02 13:45:23Z lguez $
 !
 c
@@ -23,7 +23,7 @@
 C         ierr    = severity of situation ( = 0 normal )
 
-      character (len=*) :: modname
+      character(len=*) modname
       integer ierr
-      character (len=*) :: message
+      character(len=*) message
 
       write(lunout,*) 'in abort_gcm'
@@ -45,7 +45,8 @@
       if (ierr .eq. 0) then
         write(lunout,*) 'Everything is cool'
+        stop
       else
         write(lunout,*) 'Houston, we have a problem ', ierr
-      STOP
+        stop 1
       endif
       END
Index: LMDZ5/trunk/libf/dyn3dmem/adaptdt.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/adaptdt.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/adaptdt.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: adaptdt.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: adaptdt.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       subroutine adaptdt(nadv,dtbon,n,pbaru,
Index: LMDZ5/trunk/libf/dyn3dmem/addfi_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/addfi_p.F	(revision 1657)
+++ 	(revision )
@@ -1,244 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE addfi_p(pdt, leapf, forward,
-     S          pucov, pvcov, pteta, pq   , pps ,
-     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
-      USE parallel
-      USE infotrac, ONLY : nqtot
-      IMPLICIT NONE
-c
-c=======================================================================
-c
-c    Addition of the physical tendencies
-c
-c    Interface :
-c    -----------
-c
-c      Input :
-c      -------
-c      pdt                    time step of integration
-c      leapf                  logical
-c      forward                logical
-c      pucov(ip1jmp1,llm)     first component of the covariant velocity
-c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
-c      pteta(ip1jmp1,llm)     potential temperature
-c      pts(ip1jmp1,llm)       surface temperature
-c      pdufi(ip1jmp1,llm)     |
-c      pdvfi(ip1jm,llm)       |   respective
-c      pdhfi(ip1jmp1)         |      tendencies
-c      pdtsfi(ip1jmp1)        |
-c
-c      Output :
-c      --------
-c      pucov
-c      pvcov
-c      ph
-c      pts
-c
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c
-c    0.  Declarations :
-c    ------------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "serre.h"
-c
-c    Arguments :
-c    -----------
-c
-      REAL pdt
-c
-      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
-      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
-c
-      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
-      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
-c
-      LOGICAL leapf,forward
-c
-c
-c    Local variables :
-c    -----------------
-c
-      REAL xpn(iim),xps(iim),tpn,tps
-      INTEGER j,k,iq,ij
-      REAL qtestw, qtestt
-      PARAMETER ( qtestw = 1.0e-15 )
-      PARAMETER ( qtestt = 1.0e-40 )
-
-      REAL SSUM
-      EXTERNAL SSUM
-      
-      INTEGER :: ijb,ije
-c
-c-----------------------------------------------------------------------
-      
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO k = 1,llm
-         DO j = ijb,ije
-            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
-         ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-      if (pole_nord) then
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO  k    = 1, llm
-         DO  ij   = 1, iim
-           xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
-         ENDDO
-         tpn      = SSUM(iim,xpn,1)/ apoln
-
-         DO ij   = 1, iip1
-           pteta(   ij   ,k)  = tpn
-         ENDDO
-       ENDDO
-c$OMP END DO NOWAIT
-      endif
-
-      if (pole_sud) then
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO  k    = 1, llm
-         DO  ij   = 1, iim
-           xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
-         ENDDO
-         tps      = SSUM(iim,xps,1)/ apols
-
-         DO ij   = 1, iip1
-           pteta(ij+ip1jm,k)  = tps
-         ENDDO
-       ENDDO
-c$OMP END DO NOWAIT
-      endif
-c
-
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin+iip1
-      if (pole_sud)  ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO k = 1,llm
-         DO j = ijb,ije
-            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
-         ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-      if (pole_nord) ijb=ij_begin
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO k = 1,llm
-         DO j = ijb,ije
-            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
-         ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-c
-      if (pole_sud)  ije=ij_end
-c$OMP MASTER
-      DO j = ijb,ije
-         pps(j) = pps(j) + pdpfi(j) * pdt
-      ENDDO
-c$OMP END MASTER
- 
-      DO iq = 1, 2
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-         DO k = 1,llm
-            DO j = ijb,ije
-               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
-               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
-            ENDDO
-         ENDDO
-c$OMP END DO NOWAIT
-      ENDDO
-
-      DO iq = 3, nqtot
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-         DO k = 1,llm
-            DO j = ijb,ije
-               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
-               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
-            ENDDO
-         ENDDO
-c$OMP END DO NOWAIT
-      ENDDO
-
-c$OMP MASTER
-      if (pole_nord) then
-      
-        DO  ij   = 1, iim
-          xpn(ij) = aire(   ij   ) * pps(  ij     )
-        ENDDO
-
-        tpn      = SSUM(iim,xpn,1)/apoln
-
-        DO ij   = 1, iip1
-          pps (   ij     )  = tpn
-        ENDDO
-      
-      endif
-
-      if (pole_sud) then
-      
-        DO  ij   = 1, iim
-          xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
-        ENDDO
-
-        tps      = SSUM(iim,xps,1)/apols
-
-        DO ij   = 1, iip1
-          pps ( ij+ip1jm )  = tps
-        ENDDO
-      
-      endif
-c$OMP END MASTER
-
-      if (pole_nord) then
-        DO iq = 1, nqtot
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO  k    = 1, llm
-            DO  ij   = 1, iim
-              xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
-            ENDDO
-            tpn      = SSUM(iim,xpn,1)/apoln
-  
-            DO ij   = 1, iip1
-              pq (   ij   ,k,iq)  = tpn
-            ENDDO
-          ENDDO
-c$OMP END DO NOWAIT	  
-        ENDDO
-      endif
-      
-      if (pole_sud) then
-        DO iq = 1, nqtot
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-          DO  k    = 1, llm
-            DO  ij   = 1, iim
-              xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
-            ENDDO
-            tps      = SSUM(iim,xps,1)/apols
-  
-            DO ij   = 1, iip1
-              pq (ij+ip1jm,k,iq)  = tps
-            ENDDO
-          ENDDO
-c$OMP END DO NOWAIT	  
-        ENDDO
-      endif
-      
-      
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/advect_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/advect_p.F	(revision 1657)
+++ 	(revision )
@@ -1,219 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE advect_p(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
-      USE parallel
-      USE write_field_p
-      IMPLICIT NONE
-c=======================================================================
-c
-c   Auteurs:  P. Le Van , Fr. Hourdin  .
-c   -------
-c
-c   Objet:
-c   ------
-c
-c   *************************************************************
-c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
-c   *************************************************************
-c        ces termes sont ajoutes a du,dv,dteta et dq .
-c  Modif F.Forget 03/94 : on retire q de advect
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "ener.h"
-
-c   Arguments:
-c   ----------
-
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
-      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
-
-c   Local:
-c   ------
-
-      REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
-      REAL unsaire2(ip1jmp1), ge(ip1jmp1)
-      REAL deuxjour, ww, gt, uu, vv
-
-      INTEGER  ij,l,ijb,ije
-
-      EXTERNAL  SSUM
-      REAL      SSUM
-
-c-----------------------------------------------------------------------
-c   2. Calculs preliminaires:
-c   -------------------------
-
-      IF (conser)  THEN
-         deuxjour = 2. * daysec
-
-         DO   1  ij   = 1, ip1jmp1
-         unsaire2(ij) = unsaire(ij) * unsaire(ij)
-   1     CONTINUE
-      END IF
-
-
-c------------------  -yy ----------------------------------------------
-c   .  Calcul de     u
-
-      DO  l=1,llm
-         
-         ijb=ij_begin
-         ije=ij_end
-         if (pole_nord) ijb=ijb+iip1
-         if (pole_sud)  ije=ije-iip1
-         
-c         DO    ij     = iip2, ip1jmp1
-c            uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
-c         ENDDO
-
-c         DO    ij     = iip2, ip1jm
-c            uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
-c         ENDDO
-         
-         DO    ij     = ijb, ije
-                  
-           uav(ij,l)=0.25*(ucov(ij,l)+ucov(ij-iip1,l))
-     .	             +0.25*(ucov(ij+iip1,l)+ucov(ij,l))
-         ENDDO
-         
-         if (pole_nord) then
-           DO      ij         = 1, iip1
-              uav(ij      ,l) = 0.
-           ENDDO
-         endif
-         
-         if (pole_sud) then
-           DO      ij         = 1, iip1
-              uav(ip1jm+ij,l) = 0.
-           ENDDO
-         endif
-         
-      ENDDO
-      
-c      call write_field3d_p('uav',reshape(uav,(/iip1,jjp1,llm/)))
-      
-c------------------  -xx ----------------------------------------------
-c   .  Calcul de     v
-      
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO  l=1,llm
-         
-         DO    ij   = ijb+1, ije
-           vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
-         ENDDO
-         
-         DO    ij   = ijb,ije,iip1
-          vav(ij,l) = vav(ij+iim,l)
-         ENDDO
-         
-         
-         DO    ij   = ijb, ije-1
-          vav(ij,l) = vav(ij,l) + vav(ij+1,l)
-         ENDDO
-         
-         DO    ij       = ijb, ije, iip1
-          vav(ij+iim,l) = vav(ij,l)
-         ENDDO
-         
-      ENDDO
-c       call write_field3d_p('vav',reshape(vav,(/iip1,jjm,llm/)))
-c-----------------------------------------------------------------------
-
-
-      
-      DO 20 l = 1, llmm1
-
-
-c       ......   calcul de  - w/2.    au niveau  l+1   .......
-      ijb=ij_begin
-      ije=ij_end+iip1
-      if (pole_sud)  ije=ij_end
-      
-      DO 5   ij   = ijb, ije
-      wsur2( ij ) = - 0.5 * w( ij,l+1 )
-   5  CONTINUE
-
-
-c     .....................     calcul pour  du     ..................
-      
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ijb+iip1
-      if (pole_sud)  ije=ije-iip1
-         
-      DO 6 ij = ijb ,ije-1
-      ww        = wsur2 (  ij  )     + wsur2( ij+1 ) 
-      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
-      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
-      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
-   6  CONTINUE
-
-c     .....  correction pour  du(iip1,j,l)  ........
-c     .....     du(iip1,j,l)= du(1,j,l)   .....
-
-CDIR$ IVDEP
-      DO   7  ij   = ijb+iip1-1, ije, iip1
-      du( ij, l  ) = du( ij -iim, l  )
-      du( ij,l+1 ) = du( ij -iim,l+1 )
-   7  CONTINUE
-
-c     .................    calcul pour   dv      .....................
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO 8 ij = ijb, ije
-      ww        = wsur2( ij+iip1 )   + wsur2( ij )
-      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
-      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
-      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
-   8  CONTINUE
-
-c
-
-c     ............................................................
-c     ...............    calcul pour   dh      ...................
-c     ............................................................
-
-c                       ---z
-c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
-c                   ...............
-        ijb=ij_begin
-        ije=ij_end
-        
-        DO 15 ij = ijb, ije
-         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
-         dteta(ij, l ) = dteta(ij, l )  -  ww
-         dteta(ij,l+1) = dteta(ij,l+1)  +  ww
-  15    CONTINUE
-
-c ym ---> conser a voir plus tard
-
-c      IF( conser)  THEN
-c        
-c        DO 17 ij = 1,ip1jmp1
-c        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
-c  17    CONTINUE
-c        gt       = SSUM( ip1jmp1,ge,1 )
-c        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
-c      END IF
-
-  20  CONTINUE
- 
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_p.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_p.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: bilan_dyn_p.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: bilan_dyn_p.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE bilan_dyn_p (ntrac,dt_app,dt_cum,
Index: LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F	(revision 1658)
@@ -667,5 +667,5 @@
 
 !$OMP MASTER 
-      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 
+!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 
 !$OMP END MASTER
       zdt_split=dtphys/nsplit_phys
Index: LMDZ5/trunk/libf/dyn3dmem/ce0l.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/ce0l.F90	(revision 1658)
+++ LMDZ5/trunk/libf/dyn3dmem/ce0l.F90	(revision 1658)
@@ -0,0 +1,108 @@
+!
+! $Id: ce0l.F90 1425 2010-09-02 13:45:23Z lguez $
+!
+!-------------------------------------------------------------------------------
+!
+PROGRAM ce0l
+!-------------------------------------------------------------------------------
+! Purpose: Calls etat0, creates initial states and limit_netcdf
+!
+!     interbar=.T. for barycentric interpolation inter_barxy
+!     extrap  =.T. for data extrapolation, like for the SSTs when file does not
+!                  contain ocean points only.
+!     oldice  =.T. for old-style ice, obtained using grille_m (grid_atob).
+!     masque is created in etat0, passed to limit to ensure consistancy.
+!-------------------------------------------------------------------------------
+  USE control_mod
+#ifdef CPP_EARTH
+! This prog. is designed to work for Earth
+  USE dimphy
+  USE comgeomphy
+  USE mod_phys_lmdz_para
+  USE mod_const_mpi
+  USE infotrac
+
+#ifdef CPP_IOIPSL
+  USE ioipsl, ONLY: ioconf_calendar
+#endif
+
+#endif
+  IMPLICIT NONE
+#ifndef CPP_EARTH
+  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
+#else
+!-------------------------------------------------------------------------------
+! Local variables:
+  LOGICAL, PARAMETER :: interbar=.TRUE., extrap=.FALSE., oldice=.FALSE.
+#include "dimensions.h"
+#include "paramet.h"
+#include "indicesol.h"
+#include "iniprint.h"
+#include "temps.h"
+#include "logic.h"
+  INTEGER, PARAMETER            :: longcles=20
+  REAL,    DIMENSION(longcles)  :: clesphy0
+  REAL,    DIMENSION(iip1,jjp1) :: masque
+  CHARACTER(LEN=15)             :: calnd
+!-------------------------------------------------------------------------------
+  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+
+  CALL init_mpi
+
+  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
+  WRITE(lunout,*)'---> klon=',klon
+  IF (mpi_size>1 .OR. omp_size>1) THEN
+       CALL abort_gcm('ce0l','In parallel mode,                         &
+ &                 ce0l must be called only                             &
+ &                 for 1 process and 1 task')
+  ENDIF
+
+  CALL InitComgeomphy
+
+#ifdef CPP_IOIPSL
+  SELECT CASE(calend)
+    CASE('earth_360d');CALL ioconf_calendar('360d');      calnd='a 360 jours/an'
+    CASE('earth_365d');CALL ioconf_calendar('noleap');    calnd='a 365 jours/an'
+    CASE('earth_366d');CALL ioconf_calendar('366d');      calnd='bissextile'
+    CASE('gregorian'); CALL ioconf_calendar('gregorian'); calnd='gregorien'
+    CASE('standard');  CALL ioconf_calendar('gregorian'); calnd='gregorien'
+    CASE('julian');    CALL ioconf_calendar('julian');    calnd='julien'
+    CASE('proleptic_gregorian'); CALL ioconf_calendar('gregorian')
+  !--- DC Bof...  => IOIPSL a mettre a jour: proleptic_gregorian /= gregorian
+    CASE DEFAULT
+      CALL abort_gcm('ce0l','Mauvais choix de calendrier',1)
+  END SELECT
+  WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre '//TRIM(calnd)
+#endif
+
+  IF (config_inca /= 'none') THEN
+#ifdef INCA
+    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
+    CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
+    WRITE(lunout,*)'nbtr =' , nbtr 
+#endif
+  END IF
+
+  WRITE(lunout,'(//)')
+  WRITE(lunout,*) '  *********************  '
+  WRITE(lunout,*) '  ***  etat0_netcdf ***  '
+  WRITE(lunout,*) '  *********************  '
+  WRITE(lunout,'(//)')
+  WRITE(lunout,*) ' interbar = ',interbar
+  CALL etat0_netcdf(interbar,masque,ok_etat0)
+
+  IF(ok_limit) THEN
+  WRITE(lunout,'(//)')
+  WRITE(lunout,*) '  *********************  '
+  WRITE(lunout,*) '  ***  Limit_netcdf ***  '
+  WRITE(lunout,*) '  *********************  '
+  WRITE(lunout,'(//)')
+  CALL limit_netcdf(interbar,extrap,oldice,masque)
+  END IF
+
+#endif
+! of #ifndef CPP_EARTH #else
+
+END PROGRAM ce0l
+!
+!-------------------------------------------------------------------------------
Index: LMDZ5/trunk/libf/dyn3dmem/com_io_dyn.h
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/com_io_dyn.h	(revision 1657)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      integer histid, histvid, histaveid
-      common/com_io_dyn/histid, histvid, histaveid
Index: LMDZ5/trunk/libf/dyn3dmem/comdissnew.h
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/comdissnew.h	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/comdissnew.h	(revision 1658)
@@ -1,7 +1,13 @@
 !
-! $Header$
+! $Id: comdissnew.h 1319 2010-02-23 21:29:54Z fairhead $
+!
+!
+!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
+!                 veillez à n'utiliser que des ! pour les commentaires
+!                 et à bien positionner les & des lignes de continuation 
+!                 (les placer en colonne 6 et en colonne 73)
 !
 !-----------------------------------------------------------------------
-! INCLUDE comdissnew.h
+! INCLUDE 'comdissnew.h'
 
       COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,  &
Index: LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: conf_gcm.F 1357 2010-04-14 14:03:19Z emillour $
+! $Id: conf_gcm.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
@@ -362,8 +362,4 @@
        iphysiq = 5
        CALL getin('iphysiq', iphysiq)
-
-ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
-c
-
 
 !Config  Key  = ip_ebil_dyn
@@ -863,6 +859,23 @@
        CALL getin('ok_gradsfile',ok_gradsfile)
 
+!Config  Key  = ok_limit
+!Config  Desc = creation des fichiers limit dans create_etat0_limit
+!Config  Def  = y
+!Config  Help = production du fichier limit.nc requise
+
+       ok_limit = .TRUE.
+       CALL getin('ok_limit',ok_limit)
+
+!Config  Key  = ok_etat0
+!Config  Desc = creation des fichiers etat0 dans create_etat0_limit
+!Config  Def  = y
+!Config  Help = production des fichiers start.nc, startphy.nc requise
+
+      ok_etat0 = .TRUE.
+      CALL getin('ok_etat0',ok_etat0)
+
       write(lunout,*)' #########################################'
-      write(lunout,*)' Configuration des parametres du gcm: '
+      write(lunout,*)' Configuration des parametres de cel0'
+     &             //'_limit: '
       write(lunout,*)' planet_type = ', planet_type
       write(lunout,*)' calend = ', calend
@@ -908,4 +921,6 @@
       write(lunout,*)' ok_strato = ', ok_strato
       write(lunout,*)' ok_gradsfile = ', ok_gradsfile
+      write(lunout,*)' ok_limit = ', ok_limit
+      write(lunout,*)' ok_etat0 = ', ok_etat0
 c
       RETURN
Index: LMDZ5/trunk/libf/dyn3dmem/control.h
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/control.h	(revision 1657)
+++ 	(revision )
@@ -1,29 +1,0 @@
-!
-! $Header$
-!
-!
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez à n'utiliser que des ! pour les commentaires
-!                 et à bien positionner les & des lignes de continuation 
-!                 (les placer en colonne 6 et en colonne 73)
-!
-!-----------------------------------------------------------------------
-! INCLUDE 'control.h'
-
-      COMMON/control/nday,day_step,                                     &
-     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
-     &              periodav,iecrimoy,dayref,anneeref,                  &
-     &              raz_date,offline,ip_ebil_dyn,config_inca,           &
-     &              planet_type,output_grads_dyn,ok_dynzon
-
-      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,        &
-     &          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date      &
-     &          ,ip_ebil_dyn
-      REAL periodav
-      logical offline
-      CHARACTER (len=4) :: config_inca
-      CHARACTER(len=10) :: planet_type ! planet type ('earth','mars',...)
-      LOGICAL :: output_grads_dyn ! output dynamics diagnostics in
-                                  ! binary grads file 'dyn.dat' (y/n)
-      LOGICAL :: ok_dynzon 
-!-----------------------------------------------------------------------
Index: LMDZ5/trunk/libf/dyn3dmem/convflu_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/convflu_p.F	(revision 1657)
+++ 	(revision )
@@ -1,84 +1,0 @@
-      SUBROUTINE convflu_p( xflu,yflu,nbniv,convfl )
-c
-c  P. Le Van
-c
-c
-c    *******************************************************************
-c  ... calcule la (convergence horiz. * aire locale)du flux ayant pour
-c      composantes xflu et yflu ,variables extensives .  ......
-c    *******************************************************************
-c      xflu , yflu et nbniv sont des arguments d'entree pour le s-pg ..
-c      convfl                est  un argument de sortie pour le s-pg .
-c
-c     njxflu  est le nombre de lignes de latitude de xflu, 
-c     ( = jjm ou jjp1 )
-c     nbniv   est le nombre de niveaux vert. de  xflu et de yflu .
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-      REAL       xflu,yflu,convfl,convpn,convps
-      INTEGER    l,ij,nbniv
-      DIMENSION  xflu( ip1jmp1,nbniv ),yflu( ip1jm,nbniv ) ,
-     *         convfl( ip1jmp1,nbniv )
-c
-      INTEGER ijb,ije
-      EXTERNAL   SSUM
-      REAL       SSUM
-c
-c
-#include "comgeom.h"
-c
-     
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)          
-      DO 5 l = 1,nbniv
-c
-        ijb=ij_begin
-        ije=ij_end+iip1
-      
-        IF (pole_nord) ijb=ij_begin+iip1
-        IF (pole_sud)  ije=ij_end-iip1
-        
-        DO 2  ij = ijb , ije - 1
-          convfl(ij+1,l) = xflu(ij,l) - xflu(ij+ 1,l)   +
-     *                     yflu(ij +1,l ) - yflu( ij -iim,l )
-   2    CONTINUE
-c
-c
-
-c     ....  correction pour  convfl( 1,j,l)  ......
-c     ....   convfl(1,j,l)= convfl(iip1,j,l) ...
-c
-CDIR$ IVDEP
-        DO 3 ij = ijb,ije,iip1
-          convfl( ij,l ) = convfl( ij + iim,l )
-   3    CONTINUE
-c
-c     ......  calcul aux poles  .......
-c
-        IF (pole_nord) THEN
-      
-          convpn =   SSUM( iim, yflu(     1    ,l ),  1 )
-        
-          DO ij = 1,iip1
-            convfl(ij,l) = convpn * aire(ij) / apoln
-          ENDDO
-        
-        ENDIF
-      
-        IF (pole_sud) THEN
-        
-          convps = - SSUM( iim, yflu( ip1jm-iim,l ),  1 )
-        
-          DO ij = 1,iip1
-            convfl(ij+ip1jm,l) = convps * aire(ij+ ip1jm) / apols
-          ENDDO
-        
-        ENDIF
-      
-   5  CONTINUE
-c$OMP END DO NOWAIT   
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/convmas_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/convmas_p.F	(revision 1657)
+++ 	(revision )
@@ -1,71 +1,0 @@
-      SUBROUTINE convmas_p (pbaru, pbarv, convm )
-c
-      USE parallel
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteurs:  P. Le Van , F. Hourdin  .
-c   -------
-c
-c   Objet:
-c   ------
-c
-c   ********************************************************************
-c   .... calcul de la convergence du flux de masse aux niveaux p ...
-c   ********************************************************************
-c
-c
-c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
-c      .....  convm      est  un argument de sortie pour le s-pg  ....
-c
-c    le calcul se fait de haut en bas, 
-c    la convergence de masse au niveau p(llm+1) est egale a 0. et
-c    n'est pas stockee dans le tableau convm .
-c
-c
-c=======================================================================
-c
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "logic.h"
-
-      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm )
-      REAL, target :: convm(  ip1jmp1,llm )
-      INTEGER   l,ij
-
-      INTEGER ijb,ije,jjb,jje
- 
-      
-c-----------------------------------------------------------------------
-c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
-
-      CALL  convflu_p( pbaru, pbarv, llm, convm )
-
-c-----------------------------------------------------------------------
-c   filtrage:
-c   ---------
-       
-       jjb=jj_begin
-       jje=jj_end+1
-       if (pole_sud) jje=jj_end
- 
-       CALL filtreg_p( convm, jjb, jje, jjp1, llm, 2, 2, .true., 1 )
-
-c    integration de la convergence de masse de haut  en bas ......
-       ijb=ij_begin
-       ije=ij_end+iip1
-       if (pole_sud) ije=ij_end
-            
-      DO      l      = llmm1, 1, -1
-        DO    ij     = ijb, ije
-         convm(ij,l) = convm(ij,l) + convm(ij,l+1)
-        ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/covnat_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/covnat_p.F	(revision 1657)
+++ 	(revision )
@@ -1,76 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE covnat_p(klevel,ucov, vcov, unat, vnat )
-      USE parallel
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  F Hourdin Phu LeVan
-c   -------
-c
-c   Objet:
-c   ------
-c
-c  *********************************************************************
-c    calcul des compos. naturelles a partir des comp.covariantes
-c  ********************************************************************
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      INTEGER klevel
-      REAL ucov( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
-      REAL unat( ip1jmp1,klevel ), vnat( ip1jm,klevel )
-      INTEGER   l,ij
-      INTEGER :: ijb,ije
-      
-      
-      ijb=ij_begin
-      ije=ij_end
-      
-      if (pole_nord) then
-        DO l = 1,klevel
-           DO ij = 1, iip1
-              unat (ij,l) =0.
-           END DO
-        ENDDO
-      endif
-
-      if (pole_sud) then
-        DO l = 1,klevel
-           DO ij = ip1jm+1, ip1jmp1  
-            unat (ij,l) =0.
-           END DO
-        ENDDO
-      endif
-
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin+iip1
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO l = 1,klevel
-         DO ij = ijb, ije
-            unat( ij,l ) = ucov( ij,l ) / cu(ij)
-         ENDDO
-      END DO
-
-      ijb=ij_begin-iip1
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin
-      if (pole_sud)  ije=ij_end-iip1
-     
-      DO l = 1,klevel
-         DO ij = ijb,ije
-            vnat( ij,l ) = vcov( ij,l ) / cv(ij)
-         ENDDO
-
-      ENDDO
-      
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/create_etat0_limit.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/create_etat0_limit.F	(revision 1657)
+++ 	(revision )
@@ -1,86 +1,0 @@
-!
-! $Id: create_etat0_limit.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-       PROGRAM create_etat0_limit
-#ifdef CPP_EARTH
-! This prog. is designed to work for Earth
-       USE dimphy
-       USE comgeomphy
-       USE mod_phys_lmdz_para
-       USE mod_const_mpi
-       USE infotrac
-      USE control_mod
-#ifdef CPP_IOIPSL
-       use ioipsl, only: ioconf_calendar
-#endif
-       IMPLICIT NONE
-c
-c
-c     Programme d'appel a etat0, creation des etats initiaux et limit_netcdf
-c   
-c
-c     interbar = .T . si appel a  interpol. barycentrique inter_barxy
-c
-c     extrap   = .T . si on fait une extrapolation de donnees , comme pour
-c       les  SST  lorsque  le fichier ne contient pas uniquement  des points 
-c     oceaniques .
-c
-c     oldice   = .T. si l'on veut garder les anciennes glaces , obtenues
-c     par  grille_m  ( grid_atob ) .
-c
-c     on cree le masque dans etat0 que l'on passe ensuite dans limit pour 
-c     garder les coherences
-
-      LOGICAL interbar, extrap , oldice
-      PARAMETER ( interbar = .true. , extrap = .FALSE. , oldice=.false.)
-#include "dimensions.h"
-#include "paramet.h"
-#include "indicesol.h"
-      REAL :: masque(iip1,jjp1)
-!      REAL :: pctsrf(iim*(jjm-1)+2, nbsrf)
-
-      IF (config_inca /= 'none') THEN
-#ifdef INCA
-         call init_const_lmdz(
-     $        nbtr,anneeref,dayref,
-     $        iphysiq, day_step,nday)
-#endif
-         print *, 'nbtr =' , nbtr 
-      END IF
-
-      CALL init_mpi
-
-
-      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
-      PRINT *,'---> klon=',klon
-
-      IF (mpi_size>1 .OR. omp_size>1) THEN
-        CALL abort_gcm('create_etat0_limit','In parallel mode, 
-     &                 create_etat0_limit must be called only 
-     &                 for 1 process and 1 task')
-      ENDIF
-      call InitComgeomphy
-
-#ifdef CPP_IOIPSL
-      call ioconf_calendar('360d')
-#endif
-
-      WRITE(6,*) '  *********************  '
-      WRITE(6,*) ' interbar = ',interbar
-      CALL etat0_netcdf ( interbar, masque )
-c
-      WRITE(6,1)
-      WRITE(6,*) '  *********************  '
-      WRITE(6,*) '  ***  Limit_netcdf ***  '
-      WRITE(6,*) '  *********************  '
-      WRITE(6,1)
-      
-c     
-      CALL  limit_netcdf ( interbar, extrap , oldice, masque)
-
-1     FORMAT(//)
-
-#endif
-! of #ifdef CPP_EARTH
-      STOP
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/defrun.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/defrun.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/defrun.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: defrun.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: defrun.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/disvert.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/disvert.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/disvert.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: disvert.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: disvert.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
Index: LMDZ5/trunk/libf/dyn3dmem/diverg_gam_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/diverg_gam_p.F	(revision 1657)
+++ 	(revision )
@@ -1,97 +1,0 @@
-      SUBROUTINE diverg_gam_p(klevel,cuvscvgam,cvuscugam,unsairegam ,
-     *                       unsapolnga,unsapolsga,  x, y,  div )
-c
-c     P. Le Van
-c
-c  *********************************************************************
-c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
-c     x et y...
-c              x et y  etant des composantes covariantes   ...
-c  *********************************************************************
-      USE parallel
-      IMPLICIT NONE
-c
-c      x  et  y  sont des arguments  d'entree pour le s-prog
-c        div      est  un argument  de sortie pour le s-prog
-c
-c
-c   ---------------------------------------------------------------------
-c
-c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
-c
-c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-c
-c    ..........          variables en arguments    ...................
-c
-      INTEGER klevel
-      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
-      REAL cuvscvgam(ip1jm),cvuscugam(ip1jmp1),unsairegam(ip1jmp1)
-      REAL unsapolnga,unsapolsga
-c
-c    ...............     variables  locales   .........................
-
-      REAL aiy1( iip1 ) , aiy2( iip1 )
-      REAL sumypn,sumyps
-      INTEGER   l,ij
-c    ...................................................................
-c
-      EXTERNAL  SSUM
-      REAL      SSUM
-      INTEGER :: ijb,ije,jjb,jje
-c
-c
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin+iip1
-      if(pole_sud)  ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO 10 l = 1,klevel
-c
-        DO  ij = ijb, ije - 1
-         div( ij + 1, l )     = (  
-     *  cvuscugam( ij+1 ) * x( ij+1,l ) - cvuscugam( ij ) * x( ij , l) +
-     *  cuvscvgam(ij-iim) * y(ij-iim,l) - cuvscvgam(ij+1) * y(ij+1,l) )* 
-     *         unsairegam( ij+1 )
-        ENDDO
-c
-c     ....  correction pour  div( 1,j,l)  ......
-c     ....   div(1,j,l)= div(iip1,j,l) ....
-c
-CDIR$ IVDEP
-        DO  ij = ijb,ije,iip1
-         div( ij,l ) = div( ij + iim,l )
-        ENDDO
-c
-c     ....  calcul  aux poles  .....
-c
-       if (pole_nord) then
-          DO  ij  = 1,iim
-           aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
-          ENDDO
-          sumypn = SSUM ( iim,aiy1,1 ) * unsapolnga
-c  
-          DO  ij = 1,iip1
-           div(     ij    , l ) = - sumypn 
-          ENDDO
-       endif
-        
-        if (pole_sud) then
-          DO  ij  = 1,iim
-           aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
-          ENDDO
-          sumyps = SSUM ( iim,aiy2,1 ) * unsapolsga
-c  
-          DO  ij = 1,iip1
-           div( ij + ip1jm, l ) =   sumyps 
-          ENDDO
-       endif
-  10  CONTINUE
-c$OMP END DO NOWAIT
-c
-
-       RETURN
-       END
Index: LMDZ5/trunk/libf/dyn3dmem/divergf_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/divergf_p.F	(revision 1657)
+++ 	(revision )
@@ -1,115 +1,0 @@
-      SUBROUTINE divergf_p(klevel,x,y,div)
-c
-c     P. Le Van
-c
-c  *********************************************************************
-c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 
-c     x et y...
-c              x et y  etant des composantes covariantes   ...
-c  *********************************************************************
-      USE PARALLEL
-      IMPLICIT NONE
-c
-c      x  et  y  sont des arguments  d'entree pour le s-prog
-c        div      est  un argument  de sortie pour le s-prog
-c
-c
-c   ---------------------------------------------------------------------
-c
-c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
-c
-c   ---------------------------------------------------------------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-c
-c    ..........          variables en arguments    ...................
-c
-      INTEGER klevel
-      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
-      INTEGER   l,ij
-c
-c    ...............     variables  locales   .........................
-
-      REAL aiy1( iip1 ) , aiy2( iip1 )
-      REAL sumypn,sumyps
-c    ...................................................................
-c
-      EXTERNAL  SSUM
-      REAL      SSUM
-      INTEGER :: ijb,ije,jjb,jje
-c
-c
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin+iip1
-      if(pole_sud)  ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
-      DO 10 l = 1,klevel
-c
-        DO  ij = ijb, ije - 1
-         div( ij + 1, l )     =  
-     *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +
-     *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 
-        ENDDO
-
-c
-c     ....  correction pour  div( 1,j,l)  ......
-c     ....   div(1,j,l)= div(iip1,j,l) ....
-c
-CDIR$ IVDEP
-        DO  ij = ijb,ije,iip1
-         div( ij,l ) = div( ij + iim,l )
-        ENDDO
-c
-c     ....  calcul  aux poles  .....
-c
-        if (pole_nord) then
-        
-          DO  ij  = 1,iim
-           aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
-          ENDDO
-          sumypn = SSUM ( iim,aiy1,1 ) / apoln
-
-c
-          DO  ij = 1,iip1
-           div(     ij    , l ) = - sumypn
-          ENDDO
-          
-        endif
-        
-        if (pole_sud) then
-        
-          DO  ij  = 1,iim
-           aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
-          ENDDO
-          sumyps = SSUM ( iim,aiy2,1 ) / apols
-c
-          DO  ij = 1,iip1
-           div( ij + ip1jm, l ) =   sumyps
-          ENDDO
-          
-        endif
-        
-  10    CONTINUE
-c$OMP END DO NOWAIT
-
-c
-        jjb=jj_begin
-        jje=jj_end
-        if (pole_sud) jje=jj_end-1
-        
-        CALL filtreg_p( div,jjb,jje, jjp1, klevel, 2, 2, .TRUE., 1 )
-      
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-        DO l = 1, klevel
-           DO ij = ijb,ije
-            div(ij,l) = div(ij,l) * unsaire(ij) 
-          ENDDO
-        ENDDO
-c$OMP END DO NOWAIT
-c
-       RETURN
-       END
Index: LMDZ5/trunk/libf/dyn3dmem/divgrad2_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/divgrad2_p.F	(revision 1657)
+++ 	(revision )
@@ -1,120 +1,0 @@
-      SUBROUTINE divgrad2_p ( klevel, h, deltapres, lh, divgra_out )
-c
-c     P. Le Van
-c
-c   ***************************************************************
-c
-c     .....   calcul de  (div( grad ))   de (  pext * h ) .....
-c   ****************************************************************
-c   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
-c         divgra     est  un argument  de sortie pour le s-prg
-c
-      USE parallel
-      USE times
-      USE mod_hallo
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "comdissipn.h"
-
-c    .......    variables en arguments   .......
-c
-      INTEGER klevel
-      REAL h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
-      REAL divgra_out( ip1jmp1,klevel)
-      REAL,SAVE :: divgra( ip1jmp1,llm)
-
-c
-c    .......    variables  locales    ..........
-c
-      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
-      INTEGER  l,ij,iter,lh
-c    ...................................................................
-      Type(Request) :: request_dissip
-      INTEGER ijb,ije
-c
-      signe    = (-1.)**lh
-      nudivgrs = signe * cdivh
-
-c      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
-      ijb=ij_begin
-      ije=ij_end
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l = 1, klevel
-        divgra(ijb:ije,l)=h(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-c
-c$OMP BARRIER
-       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-
-      CALL laplacien_p( klevel, divgra, divgra )
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
-      DO l = 1, klevel
-       DO ij = ijb, ije
-        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
-       ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
-      DO l = 1, klevel
-        DO ij = ijb, ije
-         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
-        ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-   
-c    ........    Iteration de l'operateur  laplacien_gam    ........
-c
-      DO  iter = 1, lh - 2
-c$OMP BARRIER
-       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-
-c$OMP BARRIER
-
-
-       CALL laplacien_gam_p ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
-     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
-      ENDDO
-c
-c    ...............................................................
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
-      DO l = 1, klevel
-        DO ij = ijb, ije
-          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
-        ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-c
-c$OMP BARRIER
-       call Register_Hallo(divgra,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-
-      CALL laplacien_p ( klevel, divgra, divgra )
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l  = 1,klevel
-      DO ij = ijb,ije
-      divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
-      ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/dynetat0.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynetat0.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/dynetat0.F	(revision 1658)
@@ -321,5 +321,5 @@
         ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
         IF (ierr .NE. NF_NOERR) THEN
-           write(lunout,*)"dynetat0: Le champ <"//tname(iq)//
+           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
      &                    "> est absent"
            write(lunout,*)"          Il est donc initialise a zero"
Index: LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F	(revision 1658)
@@ -342,7 +342,7 @@
         ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
         IF (ierr .NE. NF_NOERR) THEN
-           write(lunout,*)"dynetat0_loc: Le champ <"//tname(iq)//
-     &                    "> est absent"
-           write(lunout,*)"          Il est donc initialise a zero"
+           write(lunout,*)"dynetat0_loc: Le traceur <"                  &
+     &     //trim(tname(iq))//"> est absent"
+           write(lunout,*)"Il est donc initialise a zero"
            q(:,:,iq)=0.
         ELSE
Index: LMDZ5/trunk/libf/dyn3dmem/dynredem.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynredem.F	(revision 1657)
+++ 	(revision )
@@ -1,741 +1,0 @@
-!
-! $Id: dynredem.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-c
-      SUBROUTINE dynredem0(fichnom,iday_end,phis)
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE infotrac
-      IMPLICIT NONE
-c=======================================================================
-c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
-c=======================================================================
-c   Declarations:
-c   -------------
-#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 "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iday_end
-      REAL phis(ip1jmp1)
-      CHARACTER*(*) fichnom
-
-c   Local:
-c   ------
-      INTEGER iq,l
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr
-      character*20 modname
-      character*80 abort_message
-
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3), dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_s, idim_sig
-      INTEGER idim_tim
-      INTEGER nid,nvarid
-
-      REAL zan0,zjulian,hours
-      INTEGER yyears0,jjour0, mmois0
-      character*30 unites
-
-
-c-----------------------------------------------------------------------
-      modname='dynredem0'
-
-#ifdef CPP_IOIPSL
-      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
-      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
-#else
-! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
-      yyears0=0
-      mmois0=1
-      jjour0=1
-#endif        
-
-      DO l=1,length
-       tab_cntrl(l) = 0.
-      ENDDO
-       tab_cntrl(1)  =  REAL(iim)
-       tab_cntrl(2)  =  REAL(jjm)
-       tab_cntrl(3)  =  REAL(llm)
-       tab_cntrl(4)  =  REAL(day_ref)
-       tab_cntrl(5)  =  REAL(annee_ref)
-       tab_cntrl(6)  = rad
-       tab_cntrl(7)  = omeg
-       tab_cntrl(8)  = g
-       tab_cntrl(9)  = cpp
-       tab_cntrl(10) = kappa
-       tab_cntrl(11) = daysec
-       tab_cntrl(12) = dtvr
-       tab_cntrl(13) = etot0
-       tab_cntrl(14) = ptot0
-       tab_cntrl(15) = ztot0
-       tab_cntrl(16) = stot0
-       tab_cntrl(17) = ang0
-       tab_cntrl(18) = pa
-       tab_cntrl(19) = preff
-c
-c    .....    parametres  pour le zoom      ......   
-
-       tab_cntrl(20)  = clon
-       tab_cntrl(21)  = clat
-       tab_cntrl(22)  = grossismx
-       tab_cntrl(23)  = grossismy
-c
-      IF ( fxyhypb )   THEN
-       tab_cntrl(24) = 1.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = taux
-       tab_cntrl(29) = tauy
-      ELSE
-       tab_cntrl(24) = 0.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = 0.
-       tab_cntrl(29) = 0.
-       IF( ysinus )  tab_cntrl(27) = 1.
-      ENDIF
-
-       tab_cntrl(30) =  REAL(iday_end)
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-c
-c    .........................................................
-c
-c Creation du fichier:
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
-         WRITE(6,*)' ierr = ', ierr
-         CALL ABORT
-      ENDIF
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
-     .                       "Fichier demmarage dynamique")
-c
-c Definir les dimensions du fichiers:
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
-      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
-      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-c
-c Definir et enregistrer certains champs invariants:
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
-     .                       "Numero naturel des couches s")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Numero naturel des couches sigma")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient A pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient B pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
-#endif
-c
-c Coefficients de passage cov. <-> contra. <--> naturel
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
-#endif
-c
-c Geopentiel au sol:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
-#endif
-c
-c Definir les variables pour pouvoir les enregistrer plus tard:
-c
-      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
-c
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Temps de simulation")
-      write(unites,200)yyears0,mmois0,jjour0
-200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
-     .                         unites)
-
-c
-      dims4(1) = idim_rlonu
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse U")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatv
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse V")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
-     .                       "Temperature")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-      IF(nqtot.GE.1) THEN
-      DO iq=1,nqtot
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
-      ENDDO
-      ENDIF
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
-     .                       "C est quoi ?")
-c
-      dims3(1) = idim_rlonv
-      dims3(2) = idim_rlatu
-      dims3(3) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                       "Pression au sol")
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-      ierr = NF_CLOSE(nid) ! fermer le fichier
-
-      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
-      PRINT*,'rad,omeg,g,cpp,kappa',
-     ,        rad,omeg,g,cpp,kappa
-
-      RETURN
-      END
-      SUBROUTINE dynredem1(fichnom,time,
-     .                     vcov,ucov,teta,q,masse,ps)
-      USE infotrac
-      USE control_mod
-      IMPLICIT NONE
-c=================================================================
-c  Ecriture du fichier de redemarrage sous format NetCDF
-c=================================================================
-#include "dimensions.h"
-#include "paramet.h"
-#include "description.h"
-#include "netcdf.inc"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-
-      INTEGER l
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1,llm)                   
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL q(ip1jmp1,llm,nqtot)
-      CHARACTER*(*) fichnom
-     
-      REAL time
-      INTEGER nid, nvarid, nid_trac, nvarid_trac
-      REAL trac_tmp(ip1jmp1,llm)      
-      INTEGER ierr, ierr_file 
-      INTEGER iq
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      character*20 modname
-      character*80 abort_message
-c
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
-
-      modname = 'dynredem1'
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Pb. d ouverture "//fichnom
-         CALL abort
-      ENDIF
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      ierr = NF_INQ_VARID(nid, "temps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         print *, NF_STRERROR(ierr)
-         abort_message='Variable temps n est pas definie'
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
-#endif
-      PRINT*, "Enregistrement pour ", nb, time
-
-c
-c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
-c  on passe dans dynredem0
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Le champ <controle> est absent"
-         ierr = 1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-
-c  Ecriture des champs
-c
-      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ucov n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
-#endif
-
-      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
-#endif
-
-      ierr = NF_INQ_VARID(nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable teta n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
-#endif
-
-      IF (config_inca /= 'none') THEN
-! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
-         ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
-         IF (ierr_file .NE.NF_NOERR) THEN
-            write(6,*)' Pb d''ouverture du fichier start_trac.nc'
-            write(6,*)' ierr = ', ierr_file 
-         ENDIF
-      END IF
-
-      IF(nqtot.GE.1) THEN
-      do iq=1,nqtot 
-
-         IF (config_inca == 'none') THEN
-            ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-            IF (ierr .NE. NF_NOERR) THEN
-               PRINT*, "Variable  tname(iq) n est pas definie"
-               CALL abort
-            ENDIF
-#ifdef NC_DOUBLE
-            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-            ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-        ELSE ! config_inca = 'chem' ou 'aero'
-! lecture de la valeur du traceur dans start_trac.nc
-           IF (ierr_file .ne. 2) THEN
-             ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, tname(iq),"est absent de start_trac.nc"
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-#ifdef NC_DOUBLE
-                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-                ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-                
-             ELSE
-                PRINT*, tname(iq), "est present dans start_trac.nc"
-#ifdef NC_DOUBLE
-               ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
-#else
-               ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp)
-#endif
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Lecture echouee pour", tname(iq)
-                   CALL abort
-                ENDIF
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-#ifdef NC_DOUBLE
-                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)
-#else
-                ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)
-#endif
-               
-             ENDIF ! IF (ierr .NE. NF_NOERR)
-! fin lecture du traceur
-          ELSE                  ! si il n'y a pas de fichier start_trac.nc
-!             print *, 'il n y a pas de fichier start_trac'
-             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, "Variable  tname(iq) n est pas definie"
-                CALL abort
-             ENDIF
-#ifdef NC_DOUBLE
-             ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-             ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-          ENDIF ! (ierr_file .ne. 2)
-       END IF   ! config_inca
-      
-      ENDDO
-      ENDIF
-c
-      ierr = NF_INQ_VARID(nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable masse n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
-#endif
-c
-      ierr = NF_INQ_VARID(nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ps n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
-#endif
-
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
-
Index: LMDZ5/trunk/libf/dyn3dmem/dynredem_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/dynredem_p.F	(revision 1657)
+++ 	(revision )
@@ -1,769 +1,0 @@
-!
-! $Id: dynredem_p.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-c
-      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE parallel
-      USE infotrac
-      IMPLICIT NONE
-c=======================================================================
-c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
-c=======================================================================
-c   Declarations:
-c   -------------
-#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 "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iday_end
-      REAL phis(ip1jmp1)
-      CHARACTER*(*) fichnom
-
-c   Local:
-c   ------
-      INTEGER iq,l
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr
-      character*20 modname
-      character*80 abort_message
-
-c   Variables locales pour NetCDF:
-c
-      INTEGER dims2(2), dims3(3), dims4(4)
-      INTEGER idim_index
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
-      INTEGER idim_s, idim_sig
-      INTEGER idim_tim
-      INTEGER nid,nvarid
-
-      REAL zan0,zjulian,hours
-      INTEGER yyears0,jjour0, mmois0
-      character*30 unites
-
-c-----------------------------------------------------------------------
-      if (mpi_rank==0) then
-      
-      modname='dynredem0_p'
-
-#ifdef CPP_IOIPSL
-      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
-      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
-#else
-! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
-      yyears0=0
-      mmois0=1
-      jjour0=1
-#endif                
-
-      DO l=1,length
-       tab_cntrl(l) = 0.
-      ENDDO
-       tab_cntrl(1)  =  REAL(iim)
-       tab_cntrl(2)  =  REAL(jjm)
-       tab_cntrl(3)  =  REAL(llm)
-       tab_cntrl(4)  =  REAL(day_ref)
-       tab_cntrl(5)  =  REAL(annee_ref)
-       tab_cntrl(6)  = rad
-       tab_cntrl(7)  = omeg
-       tab_cntrl(8)  = g
-       tab_cntrl(9)  = cpp
-       tab_cntrl(10) = kappa
-       tab_cntrl(11) = daysec
-       tab_cntrl(12) = dtvr
-       tab_cntrl(13) = etot0
-       tab_cntrl(14) = ptot0
-       tab_cntrl(15) = ztot0
-       tab_cntrl(16) = stot0
-       tab_cntrl(17) = ang0
-       tab_cntrl(18) = pa
-       tab_cntrl(19) = preff
-c
-c    .....    parametres  pour le zoom      ......   
-
-       tab_cntrl(20)  = clon
-       tab_cntrl(21)  = clat
-       tab_cntrl(22)  = grossismx
-       tab_cntrl(23)  = grossismy
-c
-      IF ( fxyhypb )   THEN
-       tab_cntrl(24) = 1.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = taux
-       tab_cntrl(29) = tauy
-      ELSE
-       tab_cntrl(24) = 0.
-       tab_cntrl(25) = dzoomx
-       tab_cntrl(26) = dzoomy
-       tab_cntrl(27) = 0.
-       tab_cntrl(28) = 0.
-       tab_cntrl(29) = 0.
-       IF( ysinus )  tab_cntrl(27) = 1.
-      ENDIF
-
-       tab_cntrl(30) =  REAL(iday_end)
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-c
-c    .........................................................
-c
-c Creation du fichier:
-c
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
-         WRITE(6,*)' ierr = ', ierr
-         CALL ABORT
-      ENDIF
-c
-c Preciser quelques attributs globaux:
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
-     .                       "Fichier demmarage dynamique")
-c
-c Definir les dimensions du fichiers:
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
-      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
-      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
-      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
-      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
-      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
-      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
-      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-c
-c Definir et enregistrer certains champs invariants:
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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)
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Latitudes des points V")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
-     .                       "Numero naturel des couches s")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
-     .                       "Numero naturel des couches sigma")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient A pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
-     .                       "Coefficient B pour hybride")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
-#endif
-c
-      ierr = NF_REDEF (nid)
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
-#endif
-c
-c Coefficients de passage cov. <-> contra. <--> naturel
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonu
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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
-cIM 220306 BEG
-#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
-cIM 220306 END
-      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
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
-     .                       "Aires de chaque maille")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
-#endif
-c
-c Geopentiel au sol:
-c
-      ierr = NF_REDEF (nid)
-      dims2(1) = idim_rlonv
-      dims2(2) = idim_rlatu
-cIM 220306 BEG
-#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
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Geopotentiel au sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
-#endif
-c
-c Definir les variables pour pouvoir les enregistrer plus tard:
-c
-      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
-c
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
-     .                       "Temps de simulation")
-      write(unites,200)yyears0,mmois0,jjour0
-200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
-     .                         unites)
-
-c
-      dims4(1) = idim_rlonu
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse U")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatv
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
-     .                       "Vitesse V")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
-     .                       "Temperature")
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-
-      DO iq=1,nqtot
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
-      ENDDO
-c
-      dims4(1) = idim_rlonv
-      dims4(2) = idim_rlatu
-      dims4(3) = idim_s
-      dims4(4) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
-     .                       "C est quoi ?")
-c
-      dims3(1) = idim_rlonv
-      dims3(2) = idim_rlatu
-      dims3(3) = idim_tim
-cIM 220306 BEG
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
-cIM 220306 END
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                       "Pression au sol")
-c
-      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
-      ierr = NF_CLOSE(nid) ! fermer le fichier
-
-
-      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
-      PRINT*,'rad,omeg,g,cpp,kappa',
-     ,        rad,omeg,g,cpp,kappa
-
-      endif  ! mpi_rank==0
-      RETURN
-      END
-      SUBROUTINE dynredem1_p(fichnom,time,
-     .                     vcov,ucov,teta,q,masse,ps)
-      USE parallel
-      USE infotrac
-      USE control_mod
-      IMPLICIT NONE
-c=================================================================
-c  Ecriture du fichier de redemarrage sous format NetCDF
-c=================================================================
-#include "dimensions.h"
-#include "paramet.h"
-#include "description.h"
-#include "netcdf.inc"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-
-      INTEGER l
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1,llm)                   
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL q(ip1jmp1,llm,nqtot)
-      CHARACTER*(*) fichnom
-     
-      REAL time
-      INTEGER nid, nvarid, nid_trac, nvarid_trac
-      REAL trac_tmp(ip1jmp1,llm)      
-      INTEGER ierr, ierr_file
-      INTEGER iq
-      INTEGER length
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      character*20 modname
-      character*80 abort_message
-c
-      INTEGER nb
-      SAVE nb
-      DATA nb / 0 /
-
-      logical exist_file
-
-      call Gather_Field(ucov,ip1jmp1,llm,0)
-      call Gather_Field(vcov,ip1jm,llm,0)
-      call Gather_Field(teta,ip1jmp1,llm,0)
-      call Gather_Field(masse,ip1jmp1,llm,0)
-      call Gather_Field(ps,ip1jmp1,1,0)
-      
-      do iq=1,nqtot
-        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
-      enddo
-      
-      
-      if (mpi_rank==0) then
-      
-      modname = 'dynredem1'
-      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Pb. d ouverture "//fichnom
-         CALL abort
-      ENDIF
-
-c  Ecriture/extension de la coordonnee temps
-
-      nb = nb + 1
-      ierr = NF_INQ_VARID(nid, "temps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         print *, NF_STRERROR(ierr)
-         abort_message='Variable temps n est pas definie'
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
-#endif
-      PRINT*, "Enregistrement pour ", nb, time
-
-c
-c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
-c  on passe dans dynredem0
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         abort_message="dynredem1: Le champ <controle> est absent"
-         ierr = 1
-         CALL abort_gcm(modname,abort_message,ierr)
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-
-c  Ecriture des champs
-c
-      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ucov n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
-#endif
-
-      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
-#endif
-
-      ierr = NF_INQ_VARID(nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable teta n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
-#endif
-
-      IF (config_inca /= 'none') THEN
-! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc
-         inquire(FILE="start_trac.nc", EXIST=exist_file) 
-         print *, "EXIST", exist_file
-         if (exist_file) then 
-            ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
-            IF (ierr_file .NE.NF_NOERR) THEN
-               write(6,*)' Pb d''ouverture du fichier start_trac.nc'
-               write(6,*)' ierr = ', ierr_file 
-            ENDIF
-         else
-            ierr_file = 2
-         endif
-      END IF
-
-      do iq=1,nqtot 
-
-         IF (config_inca == 'none') THEN
-            ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-            IF (ierr .NE. NF_NOERR) THEN
-               PRINT*, "Variable  tname(iq) n est pas definie"
-               CALL abort
-            ENDIF
-#ifdef NC_DOUBLE
-            ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-            ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-        ELSE ! config_inca = 'chem' ou 'aero'
-! lecture de la valeur du traceur dans start_trac.nc
-           IF (ierr_file .ne. 2) THEN
-             ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, tname(iq),"est absent de start_trac.nc"
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-#ifdef NC_DOUBLE
-                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-                ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-                
-             ELSE
-                PRINT*, tname(iq), "est present dans start_trac.nc"
-#ifdef NC_DOUBLE
-               ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
-#else
-               ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp)
-#endif
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Lecture echouee pour", tname(iq)
-                   CALL abort
-                ENDIF
-                ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-                IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
-                ENDIF
-#ifdef NC_DOUBLE
-                ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)
-#else
-                ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)
-#endif
-               
-             ENDIF ! IF (ierr .NE. NF_NOERR)
-! fin lecture du traceur
-          ELSE                  ! si il n'y a pas de fichier start_trac.nc
-!             print *, 'il n y a pas de fichier start_trac'
-             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
-             IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, "Variable  tname(iq) n est pas definie"
-                CALL abort
-             ENDIF
-#ifdef NC_DOUBLE
-             ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
-#else
-             ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
-#endif
-          ENDIF ! (ierr_file .ne. 2)
-       END IF   ! config_inca
-      
-      ENDDO
-
-
-
-c
-      ierr = NF_INQ_VARID(nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable masse n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
-#endif
-c
-      ierr = NF_INQ_VARID(nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ps n est pas definie"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
-#endif
-
-      ierr = NF_CLOSE(nid)
-c
-      endif ! mpi_rank==0
-      
-      RETURN
-      END
-
Index: LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F	(revision 1657)
+++ 	(revision )
@@ -1,817 +1,0 @@
-!
-! $Id: etat0_netcdf.F 1379 2010-05-06 12:19:18Z lguez $
-!
-c
-c
-      SUBROUTINE etat0_netcdf (interbar, masque)
-#ifdef CPP_EARTH        
-      USE startvar
-      USE ioipsl
-      USE dimphy
-      USE control_mod
-      USE infotrac
-      USE fonte_neige_mod
-      USE pbl_surface_mod
-      USE phys_state_var_mod
-      USE filtreg_mod
-      use regr_lat_time_climoz_m, only: regr_lat_time_climoz
-      use conf_phys_m, only: conf_phys
-!     For parameterization of ozone chemistry:
-      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
-      use press_coefoz_m, only: press_coefoz
-      use regr_pr_o3_m, only: regr_pr_o3
-#endif
-!#endif of #ifdef CPP_EARTH
-      use netcdf, only: nf90_open, NF90_NOWRITE, nf90_close
-      !
-      IMPLICIT NONE
-      !
-#include "dimensions.h"
-#include "paramet.h"
-      !
-      !
-!      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2, 
-!     .KLON=KFDIA-KIDIA+1,KLEV=llm
-      !
-#ifdef CPP_EARTH    
-#include "comgeom2.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "indicesol.h"
-#include "dimsoil.h"
-#include "temps.h"
-#endif
-!#endif of #ifdef CPP_EARTH
-      ! arguments:
-      LOGICAL interbar
-      REAL :: masque(iip1,jjp1)
-
-#ifdef CPP_EARTH
-      ! local variables:
-      REAL :: latfi(klon), lonfi(klon)
-      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1)
-      REAL :: psol(iip1, jjp1), phis(iip1, jjp1)
-      REAL :: p3d(iip1, jjp1, llm+1)
-      REAL :: uvent(iip1, jjp1, llm)
-      REAL :: vvent(iip1, jjm, llm)
-      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
-      REAL :: qsat(iip1, jjp1, llm)
-      REAL,ALLOCATABLE :: q3d(:, :, :,:)
-      REAL :: tsol(klon), qsol(klon), sn(klon)
-!!      REAL :: tsolsrf(klon,nbsrf)
-      real qsolsrf(klon,nbsrf),snsrf(klon,nbsrf) 
-      REAL :: albe(klon,nbsrf), evap(klon,nbsrf)
-      REAL :: alblw(klon,nbsrf)
-      REAL :: tsoil(klon,nsoilmx,nbsrf) 
-      REAL :: frugs(klon,nbsrf), agesno(klon,nbsrf)
-      REAL :: rugmer(klon)
-      REAL :: qd(iip1, jjp1, llm)
-      REAL :: run_off_lic_0(klon)
-      ! declarations pour lecture glace de mer
-      REAL :: rugv(klon)
-      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
-      INTEGER :: itaul(1), fid
-      REAL :: lev(1), date
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
-      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
-      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
-      REAL :: flic_tmp(iip1, jjp1)
-      REAL :: champint(iim, jjp1)
-      !
-
-      CHARACTER(len=80) :: varname
-      !
-      INTEGER :: i,j, ig, l, ji,ii1,ii2
-      REAL :: xpi
-      !
-      REAL :: alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm)
-      REAL :: pk(iip1,jjp1,llm), pls(iip1,jjp1,llm), pks(ip1jmp1)
-      REAL :: workvar(iip1,jjp1,llm)
-      !
-      REAL ::  prefkap, unskap
-      !
-      real :: time_step,t_ops,t_wrt
-
-#include "comdissnew.h"
-#include "serre.h"
-#include "clesphys.h"
-
-      INTEGER  ::        longcles
-      PARAMETER      ( longcles  = 20 )
-      REAL :: clesphy0 ( longcles       )
-      REAL :: p(iip1,jjp1,llm)
-      INTEGER :: itau, iday
-      REAL :: masse(iip1,jjp1,llm)
-      REAL :: xpn,xps,xppn(iim),xpps(iim)
-      real :: time
-      REAL :: phi(ip1jmp1,llm)
-      REAL :: pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-      REAL :: w(ip1jmp1,llm)
-      REAL ::phystep
-CC      REAL :: rugsrel(iip1*jjp1)
-      REAL :: fder(klon)
-!!      real zrel(iip1*jjp1),chmin,chmax
-
-!!      CHARACTER(len=80) :: visu_file
-      INTEGER :: visuid
-
-! pour la lecture du fichier masque ocean
-      integer :: nid_o2a
-      logical :: couple = .false.
-      INTEGER :: iml_omask, jml_omask
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
-      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
-      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
-      real, dimension(klon) :: ocemask_fi
-      integer :: isst(klon-2)
-      real zx_tmp_2d(iim,jjp1)
-
-      REAL :: dummy
-
-      logical              :: ok_newmicro
-      integer              :: iflag_radia
-      logical              :: ok_journe, ok_mensuel, ok_instan, ok_hf
-      logical              :: ok_LES
-      LOGICAL              :: ok_ade, ok_aie, aerosol_couple, new_aod
-      INTEGER              :: flag_aerosol
-      REAL                 :: bl95_b0, bl95_b1
-      real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut
-      real                 :: tau_ratqs
-      integer              :: iflag_cldcon
-      integer              :: iflag_ratqs
-      integer :: iflag_coupl
-      integer :: iflag_clos
-      integer :: iflag_wake
-      integer :: iflag_thermals,nsplit_thermals
-      real    :: tau_thermals
-      integer :: iflag_thermals_ed,iflag_thermals_optflux
-      REAL      :: solarlong0
-      real :: seuil_inversion
-      real :: alp_offset
-      logical found
-
-      integer  read_climoz ! read ozone climatology
-C     Allowed values are 0, 1 and 2
-C     0: do not read an ozone climatology
-C     1: read a single ozone climatology that will be used day and night
-C     2: read two ozone climatologies, the average day and night
-C     climatology and the daylight climatology
-
-      !
-      !   Constantes 
-      !
-      pi     = 4. * ATAN(1.)
-      rad    = 6371229.
-      omeg   = 4.* ASIN(1.)/(24.*3600.)
-      g      = 9.8
-      daysec = 86400.
-      kappa  = 0.2857143
-      cpp    = 1004.70885
-      !
-      preff     = 101325.
-      pa        =  50000.
-      unskap = 1./kappa
-      !
-      jmp1    = jjm + 1
-      !
-      !    Construct a grid
-      !
-
-!      CALL defrun_new(99,.TRUE.,clesphy0)
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
-      call conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES, &
-     &                 solarlong0,seuil_inversion,                      &
-     &                 fact_cldcon, facttemps,ok_newmicro,iflag_radia,  &
-     &                 iflag_cldcon,                                    &
-     &                 iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,        &
-     &                 ok_ade, ok_aie, aerosol_couple,                  &
-     &                 flag_aerosol, new_aod,                           &
-     &                 bl95_b0, bl95_b1,                                &
-     &                 iflag_thermals,nsplit_thermals,tau_thermals,     &
-     &                 iflag_thermals_ed,iflag_thermals_optflux,        &
-     &                 iflag_coupl,iflag_clos,iflag_wake, read_climoz,  &
-     &                 alp_offset)
-
-! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
-      co2_ppm0 = co2_ppm
-
-      dtvr   = daysec/REAL(day_step)
-      print*,'dtvr',dtvr
-
-      CALL iniconst()
-      CALL inigeom()
-
-! Initialisation pour traceurs
-      call infotrac_init
-      ALLOCATE(q3d(iip1, jjp1, llm, nqtot))
-
-      CALL inifilr()
-      CALL phys_state_var_init(read_climoz)
-      !
-      latfi(1) = ASIN(1.0)
-      DO j = 2, jjm
-        DO i = 1, iim
-          latfi((j-2)*iim+1+i)=  rlatu(j)
-        ENDDO
-      ENDDO
-      latfi(klon) = - ASIN(1.0)
-      !
-      lonfi(1) = 0.0
-      DO j = 2, jjm
-        DO i = 1, iim
-          lonfi((j-2)*iim+1+i) =  rlonv(i)
-        ENDDO
-      ENDDO
-      lonfi(klon) = 0.0
-      !
-      xpi = 2.0 * ASIN(1.0)
-      DO ig = 1, klon
-        latfi(ig) = latfi(ig) * 180.0 / xpi
-        lonfi(ig) = lonfi(ig) * 180.0 / xpi
-      ENDDO
-      !
-      rlat(1) = ASIN(1.0)
-      DO j = 2, jjm
-        DO i = 1, iim
-          rlat((j-2)*iim+1+i)=  rlatu(j)
-        ENDDO
-      ENDDO
-      rlat(klon) = - ASIN(1.0)
-      !
-      rlon(1) = 0.0
-      DO j = 2, jjm
-        DO i = 1, iim
-          rlon((j-2)*iim+1+i) =  rlonv(i)
-        ENDDO
-      ENDDO
-      rlon(klon) = 0.0
-      !
-      xpi = 2.0 * ASIN(1.0)
-      DO ig = 1, klon
-        rlat(ig) = rlat(ig) * 180.0 / xpi
-        rlon(ig) = rlon(ig) * 180.0 / xpi
-      ENDDO
-      !
-      
-
-
-C
-C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
-C utilise pour calculer les poids et pour assurer l'adequation entre les
-C fractions d'ocean vu par l'atmosphere et l'ocean. Sinon, on cree le masque 
-C a partir du fichier relief
-C
-
-      write(*,*)'Essai de lecture masque ocean'
-      iret = nf90_open("o2a.nc", NF90_NOWRITE, nid_o2a)
-      if (iret .ne. 0) then
-        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
-        write(*,*)'Run force'
-        varname = 'masque'
-        masque(:,:) = 0.0
-        CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, masque,
-     $       0.0, jjm ,rlonu,rlatv , interbar )
-        WRITE(*,*) 'MASQUE construit : Masque'
-        WRITE(*,'(97I1)') nINT(masque(:,:))
-        call gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
-        WHERE (zmasq(1 : klon) .LT. EPSFRA)
-            zmasq(1 : klon) = 0.
-        END WHERE 
-        WHERE (1. - zmasq(1 : klon) .LT. EPSFRA)
-            zmasq(1 : klon) = 1.
-        END WHERE 
-      else
-        couple = .true.
-        iret = nf90_close(nid_o2a)
-        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
-     $    , nid_o2a)
-        if (iml_omask /= iim .or. jml_omask /= jjp1) then
-          write(*,*)'Dimensions non compatibles pour masque ocean'
-          write(*,*)'iim = ',iim,' iml_omask = ',iml_omask
-          write(*,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
-          stop
-        endif
-        ALLOCATE(lat_omask(iml_omask, jml_omask), stat=iret)
-        ALLOCATE(lon_omask(iml_omask, jml_omask), stat=iret)
-        ALLOCATE(dlon_omask(iml_omask), stat=iret)
-        ALLOCATE(dlat_omask(jml_omask), stat=iret)
-        ALLOCATE(ocemask(iml_omask, jml_omask), stat=iret)
-        ALLOCATE(ocetmp(iml_omask, jml_omask), stat=iret)
-        CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp
-     $    , lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
-        CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, 
-     $      ttm_tmp, 1, 1, ocetmp)
-        CALL flinclo(fid)
-        dlon_omask(1 : iml_omask) = lon_omask(1 : iml_omask, 1)
-        dlat_omask(1 : jml_omask) = lat_omask(1 , 1 : jml_omask)
-        ocemask = ocetmp
-        if (dlat_omask(1) < dlat_omask(jml_omask)) then
-          do j = 1, jml_omask
-            ocemask(:,j) = ocetmp(:,jml_omask-j+1)
-          enddo
-        endif 
-C
-C passage masque ocean a la grille physique
-C
-        write(*,*)'ocemask '
-        write(*,'(96i1)')int(ocemask)
-        ocemask_fi(1) = ocemask(1,1)
-        do j = 2, jjm
-          do i = 1, iim
-            ocemask_fi((j-2)*iim + i + 1) = ocemask(i,j)
-          enddo
-        enddo
-        ocemask_fi(klon) = ocemask(1,jjp1)
-        zmasq = 1. - ocemask_fi
-      endif
-
-      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
-
-      varname = 'relief'
-      ! This line needs to be replaced by a call to restget to get the values in the restart file
-      orog(:,:) = 0.0
-       CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, orog,
-     $     0.0 , jjm ,rlonu,rlatv , interbar, masque )
-      !
-      WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
-!      WRITE(*,'(49I1)') INT(orog(:,:))
-      !
-      varname = 'rugosite'
-      ! This line needs to be replaced by a call to restget to get the values in the restart file
-      rugo(:,:) = 0.0
-       CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, rugo,
-     $     0.0 , jjm, rlonu,rlatv , interbar )
-      !
-      WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite' 
-!      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
-      !
-C
-C on initialise les sous surfaces
-C
-      pctsrf=0.
-c
-      varname = 'psol'
-      psol(:,:) = 0.0
-      CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, psol,
-     $     0.0 , jjm ,rlonu,rlatv , interbar )
-      !
-      !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM 
-      !  anyway.
-      !
-!      WRITE(*,*) 'PSOL :', psol(10,20)
-!      WRITE(*,*) ap(:), bp(:)
-      CALL pression(ip1jmp1, ap, bp, psol, p3d)
-!      WRITE(*,*) 'P3D :', p3d(10,20,:)
-      CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, workvar)
-!      WRITE(*,*) 'PK:', pk(10,20,:)
-      !
-      !
-      !
-      prefkap =  preff  ** kappa
-!      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
-      DO l = 1, llm
-        DO j=1,jjp1
-          DO i =1, iip1
-            pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-           ENDDO
-        ENDDO
-      ENDDO
-      !
-!      WRITE(*,*) 'PLS :', pls(10,20,:)
-      !
-      varname = 'surfgeo'
-      phis(:,:) = 0.0
-      CALL startget_phys2d(varname, iip1, jjp1, rlonv, rlatu, phis,
-     $     0.0 , jjm ,rlonu,rlatv, interbar )
-      !
-      varname = 'u'
-      uvent(:,:,:) = 0.0
-      CALL startget_dyn(varname, rlonu, rlatu, pls, workvar, uvent, 0.,
-     $     rlonv, rlatv, interbar )
-      !  
-      varname = 'v'
-      vvent(:,:,:) = 0.0
-      CALL startget_dyn(varname, rlonv, rlatv, pls(:, :jjm, :),
-     . workvar(:, :jjm, :), vvent, 0., rlonu, rlatu(:jjm), interbar )
-      !
-      varname = 't'
-      t3d(:,:,:) = 0.0
-      CALL startget_dyn(varname, rlonv, rlatu, pls, workvar, t3d, 0.,
-     $     rlonu, rlatv , interbar )
-      !
-      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
-     .                          maxval(t3d(:,:,:))
-      varname = 'tpot'
-      tpot(:,:,:) = 0.0
-      CALL startget_dyn(varname, rlonv, rlatu, pls, pk, tpot, 0., rlonu,
-     $     rlatv, interbar)
-      !
-      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
-     .                          maxval(t3d(:,:,:))
-      WRITE(*,*) 'PLS min,max:',minval(pls(:,:,:)),
-     .                          maxval(pls(:,:,:))
-
-c Calcul de l'humidite a saturation
-      print*,'avant q_sat'
-      call q_sat(llm*jjp1*iip1,t3d,pls,qsat)
-      print*,'apres q_sat'
-
-      WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
-     .                           maxval(qsat(:,:,:))
-      !
-CC      WRITE(*,*) 'QSAT :', qsat(10,20,:)
-      !
-      varname = 'q'
-      qd(:,:,:) = 0.0
-      q3d(:,:,:,:) = 0.0
-      WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
-     .                           maxval(qsat(:,:,:))
-      CALL startget_dyn(varname, rlonv, rlatu, pls, qsat, qd, 0., rlonu,
-     $     rlatv , interbar )
-      q3d(:,:,:,1) = qd(:,:,:)
-      !
-!     Parameterization of ozone chemistry:
-C     Look for ozone tracer:
-      i = 1
-      DO
-         found = tname(i)=="O3" .OR. tname(i)=="o3"
-         if (found .or. i == nqtot) exit
-         i = i + 1
-      end do
-      if (found) then
-         call regr_lat_time_coefoz
-         call press_coefoz
-         call regr_pr_o3(p3d, q3d(:, :, :, i))
-C     Convert from mole fraction to mass fraction:
-         q3d(:, :, :, i) = q3d(:, :, :, i)  * 48. / 29.
-      end if
-
-!     Ozone climatology:
-      if (read_climoz >= 1) call regr_lat_time_climoz(read_climoz)
-
-      varname = 'tsol'
-      ! This line needs to be replaced by a call to restget to get the values in the restart file
-      tsol(:) = 0.0
-      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon,
-     $     tsol, 0.0, jjm, rlonu, rlatv , interbar )
-      !
-      WRITE(*,*) 'TSOL construit :'
-!      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
-      !
-      varname = 'qsol'
-      qsol(:) = 0.0
-      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon,
-     $     qsol, 0.0, jjm, rlonu, rlatv , interbar )
-      !
-      varname = 'snow'
-      sn(:) = 0.0
-      CALL startget_phys1d(varname, iip1, jjp1, rlonv, rlatu, klon, sn,
-     $     0.0, jjm, rlonu, rlatv , interbar )
-      !
-      varname = 'rads'
-      radsol(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,
-     $     0.0, jjm, rlonu, rlatv , interbar )
-      !
-      varname = 'rugmer'
-      rugmer(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,
-     $     0.0, jjm, rlonu, rlatv , interbar )
-      !
-!      varname = 'agesno'
-!      agesno(:) = 0.0
-!      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
-!     .     jjm, rlonu, rlatv , interbar )
-
-      varname = 'zmea'
-      zmea(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-
-      varname = 'zstd'
-      zstd(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-      varname = 'zsig'
-      zsig(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-      varname = 'zgam'
-      zgam(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-      varname = 'zthe'
-      zthe(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-      varname = 'zpic'
-      zpic(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-      varname = 'zval'
-      zval(:) = 0.0
-      CALL startget_phys1d(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
-     .     jjm, rlonu, rlatv , interbar )
-c
-cc      rugsrel(:) = 0.0
-cc      IF(ok_orodr)  THEN
-cc        DO i = 1, iip1* jjp1
-cc         rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
-cc        ENDDO
-cc      ENDIF
-
-
-C
-C lecture du fichier glace de terre pour fixer la fraction de terre 
-C et de glace de terre
-C
-      CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp
-     $    , fid)
-      ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret)
-      ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret)
-      ALLOCATE(dlon_lic(iml_lic), stat=iret)
-      ALLOCATE(dlat_lic(jml_lic), stat=iret)
-      ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret)
-      CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp
-     $    , lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
-      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp
-     $    , 1, 1, fraclic)
-      CALL flinclo(fid)
-C
-C interpolation sur la grille T du modele
-C
-      WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ', 
-     $    iml_lic, jml_lic
-c
-C sil les coordonnees sont en degres, on les transforme
-C
-      IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) )  THEN
-          lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180.
-      ENDIF 
-      IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN 
-          lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180.
-      ENDIF 
-
-      dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1)
-      dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic) 
-C
-      CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic
-     $    ,iim, jjp1,
-     $    rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1))
-cx$$$      flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1)
-      flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1)
-C
-C passage sur la grille physique
-C
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp,
-     $    pctsrf(1:klon, is_lic))
-C adequation avec le maque terre/mer
-c      zmasq(157) = 0.
-      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA ) 
-          pctsrf(1 : klon, is_lic) = 0. 
-      END WHERE
-      WHERE (zmasq( 1 : klon) .LT. EPSFRA) 
-          pctsrf(1 : klon, is_lic) = 0.
-      END WHERE 
-      pctsrf(1 : klon, is_ter) = zmasq(1 : klon)
-      DO ji = 1, klon
-        IF (zmasq(ji) .GT. EPSFRA) THEN 
-            IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN
-                pctsrf(ji, is_lic) = zmasq(ji)
-                pctsrf(ji, is_ter) = 0.
-            ELSE 
-                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
-                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
-                    pctsrf(ji,is_ter) = 0.
-                    pctsrf(ji, is_lic) = zmasq(ji)
-                ENDIF 
-            ENDIF 
-        ENDIF 
-      END DO 
-C
-C sous surface ocean et glace de mer (pour demarrer on met glace de mer a 0)
-C
-      pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
-
-
-      WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA)
-          pctsrf(1 : klon, is_oce) = 0.
-      END WHERE 
-
-      if (couple) pctsrf(1 : klon, is_oce) = ocemask_fi(1 : klon)
-
-      isst = 0
-      where (pctsrf(2:klon-1,is_oce) >0.) isst = 1
-C
-C verif que somme des sous surface = 1
-C
-      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf),dim=2))-1.0) 
-     $    .GT. EPSFRA)
-      IF (ji .NE. 0) THEN
-          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
-      ENDIF 
-
-!      where (pctsrf(1:klon, is_ter) >= .5) 
-!        pctsrf(1:klon, is_ter) = 1.
-!        pctsrf(1:klon, is_oce) = 0.
-!        pctsrf(1:klon, is_sic) = 0.
-!        pctsrf(1:klon, is_lic) = 0.
-!        zmasq = 1.
-!      endwhere
-!      where (pctsrf(1:klon, is_lic) >= .5) 
-!        pctsrf(1:klon, is_ter) = 0.
-!        pctsrf(1:klon, is_oce) = 0.
-!        pctsrf(1:klon, is_sic) = 0.
-!        pctsrf(1:klon, is_lic) = 1.
-!        zmasq = 1.
-!      endwhere
-!      where (pctsrf(1:klon, is_oce) >= .5) 
-!        pctsrf(1:klon, is_ter) = 0.
-!        pctsrf(1:klon, is_oce) = 1.
-!        pctsrf(1:klon, is_sic) = 0.
-!        pctsrf(1:klon, is_lic) = 0.
-!        zmasq = 0.
-!      endwhere
-!      where (pctsrf(1:klon, is_sic) >= .5) 
-!        pctsrf(1:klon, is_ter) = 0.
-!        pctsrf(1:klon, is_oce) = 0.
-!        pctsrf(1:klon, is_sic) = 1.
-!        pctsrf(1:klon, is_lic) = 0.
-!        zmasq = 0.
-!      endwhere
-!      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
-C
-C verif que somme des sous surface = 1
-C
-!      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 ) 
-!     $    .GT. EPSFRA)
-!      IF (ji .NE. 0) THEN
-!          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
-!     ENDIF 
-
-      CALL gr_fi_ecrit(1,klon,iim,jjp1,zmasq,zx_tmp_2d)
-      write(*,*)'zmasq = '
-      write(*,'(96i1)')nint(zx_tmp_2d)
-      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
-      WRITE(*,*) 'MASQUE construit : Masque'
-      WRITE(*,'(97I1)') nINT(masque(:,:))
-
-
-
-C Calcul intermediaire
-c 
-      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
-      q3d(iip1,:,:,:) = q3d(1,:,:,:)
-      phis(iip1,:) = phis(1,:)
-
-C Ecriture
-      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
-     *                tetagdiv, tetagrot , tetatemp              )
-      print*,'sortie inidissip'
-      itau = 0
-      itau_dyn = 0
-      itau_phy = 0
-      iday = dayref +itau/day_step
-      time = real(itau-(iday-dayref)*day_step)/day_step
-c     
-      IF(time.GT.1)  THEN
-       time = time - 1
-       iday = iday + 1
-      ENDIF
-      day_ref = dayref
-      annee_ref = anneeref
-
-      CALL geopot  ( ip1jmp1, tpot  , pk , pks,  phis  , phi   )
-      print*,'sortie geopot'
-      
-      CALL caldyn0 ( itau,uvent,vvent,tpot,psol,masse,pk,phis ,
-     *                phi,w, pbaru,pbarv,time+iday-dayref   )
-       print*,'sortie caldyn0'     
-      CALL dynredem0("start.nc",dayref,phis)
-      print*,'sortie dynredem0'
-      CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,masse ,
-     .                            psol)
-      print*,'sortie dynredem1' 
-C
-C Ecriture etat initial physique
-C
-      write(*,*)'phystep ',dtvr,iphysiq,nbapp_rad
-      phystep   = dtvr * REAL(iphysiq)
-      radpas    = NINT (86400./phystep/ REAL(nbapp_rad) )
-      write(*,*)'phystep =', phystep, radpas
-cIM : lecture de co2_ppm & solaire ds physiq.def
-c     co2_ppm   = 348.0
-c     solaire   = 1365.0
-
-c
-c Initialisation 
-c tsol, qsol, sn,albe, evap,tsoil,rain_fall, snow_fall,solsw, sollw,frugs
-c
-      ftsol(:,is_ter) = tsol
-      ftsol(:,is_lic) = tsol
-      ftsol(:,is_oce) = tsol
-      ftsol(:,is_sic) = tsol
-      snsrf(:,is_ter) = sn
-      snsrf(:,is_lic) = sn
-      snsrf(:,is_oce) = sn
-      snsrf(:,is_sic) = sn
-      falb1(:,is_ter) = 0.08
-      falb1(:,is_lic) = 0.6
-      falb1(:,is_oce) = 0.5
-      falb1(:,is_sic) = 0.6
-      falb2 = falb1
-      evap(:,:) = 0.
-      qsolsrf(:,is_ter) = 150
-      qsolsrf(:,is_lic) = 150
-      qsolsrf(:,is_oce) = 150.
-      qsolsrf(:,is_sic) = 150.
-      do i = 1, nbsrf
-        do j = 1, nsoilmx
-          tsoil(:,j,i) = tsol
-        enddo
-      enddo
-      rain_fall = 0.; snow_fall = 0.
-      solsw = 165.
-      sollw = -53.
-      t_ancien = 273.15
-      q_ancien = 0.
-      agesno = 0.
-c
-      frugs(1:klon,is_oce) = rugmer(1:klon)
-      frugs(1:klon,is_ter) = MAX(1.0e-05, zstd(1:klon)*zsig(1:klon)/2.0)
-      frugs(1:klon,is_lic) = MAX(1.0e-05, zstd(1:klon)*zsig(1:klon)/2.0)
-      frugs(1:klon,is_sic) = 0.001
-      fder = 0.0
-      clwcon = 0.0
-      rnebcon = 0.0
-      ratqs = 0.0
-      run_off_lic_0 = 0.0 
-      rugoro = 0.0
-
-c
-c Avant l'appel a phyredem, on initialize les modules de surface
-c avec les valeurs qui vont etre ecrit dans startphy.nc
-c
-      dummy = 1.0
-      pbl_tke(:,:,:) = 1.e-8 
-      zmax0(:) = 40.
-      f0(:) = 1.e-5
-      ema_work1(:,:) = 0.
-      ema_work2(:,:) = 0.
-      wake_deltat(:,:) = 0.
-      wake_deltaq(:,:) = 0.
-      wake_s(:) = 0.
-      wake_cstar(:) = 0.
-      wake_fip(:) = 0.
-      wake_pe = 0.
-      fm_therm = 0.
-      entr_therm = 0.
-      detr_therm = 0.
-
-      call fonte_neige_init(run_off_lic_0)
-      call pbl_surface_init(qsol, fder, snsrf, qsolsrf,
-     $     evap, frugs, agesno, tsoil)
-
-      call phyredem("startphy.nc")
-
-
-
-C     Sortie Visu pour les champs dynamiques
-cc      if (1.eq.0 ) then
-cc      print*,'sortie visu'
-cc      time_step = 1.
-cc      t_ops = 2.
-cc      t_wrt = 2.
-cc      itau = 2.
-cc      visu_file='Etat0_visu.nc'
-cc      CALL initdynav(visu_file,dayref,anneeref,time_step,
-cc     .              t_ops, t_wrt, visuid)
-cc      CALL writedynav(visuid, itau,vvent ,
-cc     .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
-cc      else
-         print*,'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
-cc      endif
-      print*,'entree histclo'
-      CALL histclo
-
-#endif 
-!#endif of #ifdef CPP_EARTH
-      RETURN
-      !
-      END SUBROUTINE etat0_netcdf
Index: LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90	(revision 1658)
+++ LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90	(revision 1658)
@@ -0,0 +1,526 @@
+!
+! $Id: etat0_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE etat0_netcdf(ib, masque, letat0)
+!
+!-------------------------------------------------------------------------------
+! Purpose: Creates initial states
+!-------------------------------------------------------------------------------
+! Note: This routine is designed to work for Earth
+!-------------------------------------------------------------------------------
+  USE control_mod
+#ifdef CPP_EARTH
+  USE startvar
+  USE ioipsl
+  USE dimphy
+  USE infotrac
+  USE fonte_neige_mod
+  USE pbl_surface_mod
+  USE phys_state_var_mod
+  USE filtreg_mod
+  USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
+  USE conf_phys_m,            ONLY: conf_phys
+! For parameterization of ozone chemistry:
+  use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
+  use press_coefoz_m, only: press_coefoz
+  use regr_pr_o3_m, only: regr_pr_o3
+  USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
+#endif
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+#include "dimensions.h"
+#include "paramet.h"
+#include "iniprint.h"
+  LOGICAL,                    INTENT(IN)    :: ib     ! barycentric interpolat.
+  REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask
+  LOGICAL,                    INTENT(IN)    :: letat0 ! F: masque only required
+#ifndef CPP_EARTH
+  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
+#else
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "comgeom2.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "indicesol.h"
+#include "dimsoil.h"
+#include "temps.h"
+  REAL,    DIMENSION(klon)                 :: tsol, qsol
+  REAL,    DIMENSION(klon)                 :: sn, rugmer, run_off_lic_0
+  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol, phis
+  REAL,    DIMENSION(iip1,jjp1,llm+1)      :: p3d
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: uvent, t3d, tpot, qsat, qd
+  REAL,    DIMENSION(iip1,jjm ,llm)        :: vvent
+  REAL,    DIMENSION(:,:,:,:), ALLOCATABLE :: q3d
+  REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf, evap
+  REAL,    DIMENSION(klon,nbsrf)           :: frugs, agesno
+  REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
+
+!--- Local variables for sea-ice reading:
+  INTEGER                                  :: iml_lic, jml_lic, llm_tmp
+  INTEGER                                  :: ttm_tmp, iret, fid
+  INTEGER, DIMENSION(1)                    :: itaul
+  REAL,    DIMENSION(1)                    :: lev
+  REAL                                     :: date
+  REAL,    DIMENSION(:,:),   ALLOCATABLE   ::  lon_lic,  lat_lic, fraclic
+  REAL,    DIMENSION(:),     ALLOCATABLE   :: dlon_lic, dlat_lic
+  REAL,    DIMENSION(iip1,jjp1)            :: flic_tmp
+
+!--- Misc
+  CHARACTER(LEN=80)                        :: x, fmt
+  INTEGER                                  :: i, j, l, ji
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: alpha, beta, pk, pls, y
+  REAL,    DIMENSION(ip1jmp1)              :: pks
+
+#include "comdissnew.h"
+#include "serre.h"
+#include "clesphys.h"
+
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: masse
+  INTEGER :: itau, iday
+  REAL    :: xpn, xps, time, phystep
+  REAL,    DIMENSION(iim)                  :: xppn, xpps
+  REAL,    DIMENSION(ip1jmp1,llm)          :: pbaru, phi, w
+  REAL,    DIMENSION(ip1jm  ,llm)          :: pbarv
+  REAL,    DIMENSION(klon)                 :: fder
+
+!--- Local variables for ocean mask reading:
+  INTEGER :: nid_o2a, iml_omask, jml_omask
+  LOGICAL :: couple=.FALSE.
+  REAL,    DIMENSION(:,:), ALLOCATABLE ::  lon_omask, lat_omask, ocemask, ocetmp
+  REAL,    DIMENSION(:),   ALLOCATABLE :: dlon_omask,dlat_omask
+  REAL,    DIMENSION(klon)             :: ocemask_fi
+  INTEGER, DIMENSION(klon-2)           :: isst
+  REAL,    DIMENSION(iim,jjp1)         :: zx_tmp_2d
+  REAL    :: dummy
+  LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
+  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod
+  INTEGER :: iflag_radia, flag_aerosol
+  REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
+  REAL    :: tau_ratqs
+  INTEGER :: iflag_cldcon, iflag_ratqs, iflag_coupl, iflag_clos, iflag_wake
+  INTEGER :: iflag_thermals, nsplit_thermals
+  INTEGER :: iflag_thermals_ed, iflag_thermals_optflux
+  REAL    :: tau_thermals, solarlong0,  seuil_inversion
+  INTEGER :: read_climoz ! read ozone climatology
+!  Allowed values are 0, 1 and 2
+!     0: do not read an ozone climatology
+!     1: read a single ozone climatology that will be used day and night
+!     2: read two ozone climatologies, the average day and night
+!     climatology and the daylight climatology
+!-------------------------------------------------------------------------------
+  REAL    :: alp_offset
+  logical found
+
+!--- Constants
+  pi     = 4. * ATAN(1.)
+  rad    = 6371229.
+  daysec = 86400.
+  omeg   = 2.*pi/daysec
+  g      = 9.8
+  kappa  = 0.2857143
+  cpp    = 1004.70885
+  preff  = 101325.
+  pa     = 50000.
+  jmp1   = jjm + 1
+
+!--- CONSTRUCT A GRID
+  CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
+                   solarlong0,seuil_inversion,                          &
+                   fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
+                   iflag_cldcon,                                        &
+                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
+                   ok_ade, ok_aie, aerosol_couple,                      &
+                   flag_aerosol, new_aod,                               &
+                   bl95_b0, bl95_b1,                                    &
+                   iflag_thermals,nsplit_thermals,tau_thermals,         &
+                   iflag_thermals_ed,iflag_thermals_optflux,            &
+                   iflag_coupl,iflag_clos,iflag_wake, read_climoz,      &
+                   alp_offset)
+
+! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
+  co2_ppm0 = co2_ppm
+
+  dtvr   = daysec/FLOAT(day_step)
+  WRITE(lunout,*)'dtvr',dtvr
+
+  CALL iniconst()
+  CALL inigeom()
+
+!--- Initializations for tracers
+  CALL infotrac_init
+  ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
+
+  CALL inifilr()
+  CALL phys_state_var_init(read_climoz)
+
+  rlat(1) = ASIN(1.0)
+  DO j=2,jjm; rlat((j-2)*iim+2:(j-1)*iim+1)=rlatu(j);     END DO
+  rlat(klon) = - ASIN(1.0)
+  rlat(:)=rlat(:)*(180.0/pi)
+
+  rlon(1) = 0.0
+  DO j=2,jjm; rlon((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:iim); END DO
+  rlon(klon) = 0.0
+  rlon(:)=rlon(:)*(180.0/pi)
+
+! For a coupled simulation, the ocean mask from ocean model is used to compute
+! the weights an to insure ocean fractions are the same for atmosphere and ocean
+! Otherwise, mask is created using Relief file.
+
+  WRITE(lunout,*)'Essai de lecture masque ocean'
+  iret = NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)
+  IF(iret/=NF90_NOERR) THEN
+    WRITE(lunout,*)'ATTENTION!! pas de fichier o2a.nc trouve'
+    WRITE(lunout,*)'Run force'
+    x='masque'
+    masque(:,:)=0.0
+    CALL startget_phys2d(x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, &
+   &              rlonu, rlatv, ib)
+    WRITE(lunout,*)'MASQUE construit : Masque'
+    WRITE(lunout,'(97I1)') nINT(masque)
+    CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
+    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
+    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
+  ELSE
+    WRITE(lunout,*)'ATTENTION!! fichier o2a.nc trouve'
+    WRITE(lunout,*)'Run couple'
+    couple=.true.
+    iret=NF90_CLOSE(nid_o2a)
+    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
+    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
+      WRITE(lunout,*)'Dimensions non compatibles pour masque ocean'
+      WRITE(lunout,*)'iim = ',iim,' iml_omask = ',iml_omask
+      WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
+      CALL abort_gcm('etat0_netcdf','Dimensions non compatibles pour masque oc&
+     &ean',1)
+    END IF
+    ALLOCATE(   ocemask(iml_omask,jml_omask),   ocetmp(iml_omask,jml_omask))
+    ALLOCATE( lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask))
+    ALLOCATE(dlon_omask(iml_omask),         dlat_omask(jml_omask))
+    CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask,&
+   &              lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
+    CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, &
+   &              1, 1, ocetmp)
+    CALL flinclo(fid)
+    dlon_omask(1:iml_omask) = lon_omask(1:iml_omask,1)
+    dlat_omask(1:jml_omask) = lat_omask(1,1:jml_omask)
+    ocemask = ocetmp
+    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
+      DO j=1,jml_omask
+        ocemask(:,j) = ocetmp(:,jml_omask-j+1)
+      END DO
+    END IF
+!
+! Ocean mask to physical grid
+!*******************************************************************************
+    WRITE(lunout,*)'ocemask '
+    WRITE(fmt,"(i4,'i1)')")iml_omask ; fmt='('//ADJUSTL(fmt)
+    WRITE(lunout,fmt)int(ocemask)
+    ocemask_fi(1)=ocemask(1,1)
+    DO j=2,jjm; ocemask_fi((j-2)*iim+2:(j-1)*iim+1)=ocemask(1:iim,j); END DO
+    ocemask_fi(klon)=ocemask(1,jjp1)
+    zmasq=1.-ocemask_fi
+  END IF
+
+  CALL gr_fi_dyn(1,klon,iip1,jjp1,zmasq,masque)
+
+  ! The startget calls need to be replaced by a call to restget to get the
+  ! values in the restart file
+  x = 'relief'; orog(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, orog, 0.0,jjm,rlonu,rlatv,ib,&
+ &               masque)
+
+  x = 'rugosite'; rugo(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, rugo, 0.0,jjm, rlonu,rlatv,ib)
+!  WRITE(lunout,'(49I1)') INT(orog(:,:)*10)
+!  WRITE(lunout,'(49I1)') INT(rugo(:,:)*10)
+
+! Sub-surfaces initialization
+!*******************************************************************************
+  pctsrf=0.
+  x = 'psol'; psol(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib)
+!  WRITE(lunout,*) 'PSOL :', psol(10,20)
+!  WRITE(lunout,*) ap(:), bp(:)
+
+! Mid-levels pressure computation
+!*******************************************************************************
+  CALL pression(ip1jmp1, ap, bp, psol, p3d)
+  CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
+  pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)
+!  WRITE(lunout,*) 'P3D :', p3d(10,20,:)
+!  WRITE(lunout,*) 'PK:',    pk(10,20,:)
+!  WRITE(lunout,*) 'PLS :', pls(10,20,:)
+
+  x = 'surfgeo'; phis(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib)
+
+  x = 'u';    uvent(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonu,rlatu,pls,y,uvent,0.0,  &
+ &                  rlonv,rlatv,ib)
+
+  x = 'v';    vvent(:,:,:) = 0.0
+  CALL startget_dyn(x, rlonv,rlatv,pls(:, :jjm, :),y(:, :jjm, :),vvent,0.0, &
+ &                  rlonu,rlatu(:jjm),ib)
+
+  x = 't';    t3d(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,y,t3d,0.0,    &
+ &                  rlonu,rlatv,ib)
+
+  x = 'tpot'; tpot(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,pk,tpot,0.0,  &
+ &                  rlonu,rlatv,ib)
+
+  WRITE(lunout,*) 'T3D min,max:',minval(t3d(:,:,:)),maxval(t3d(:,:,:))
+  WRITE(lunout,*) 'PLS min,max:',minval(pls(:,:,:)),maxval(pls(:,:,:))
+
+! Humidity at saturation computation
+!*******************************************************************************
+  WRITE(lunout,*) 'avant q_sat'
+  CALL q_sat(llm*jjp1*iip1, t3d, pls, qsat)
+  WRITE(lunout,*) 'apres q_sat'
+  WRITE(lunout,*) 'QSAT min,max:',minval(qsat(:,:,:)),maxval(qsat(:,:,:))
+!  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
+
+  x = 'q';    qd (:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,qsat,qd,0.0, rlonu,rlatv,ib)
+  q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:)
+
+! Parameterization of ozone chemistry:
+! Look for ozone tracer:
+  i = 1
+  DO
+    found = tname(i)=="O3" .OR. tname(i)=="o3"
+    if (found .or. i == nqtot) exit
+    i = i + 1
+  end do
+  if (found) then
+    call regr_lat_time_coefoz
+    call press_coefoz
+    call regr_pr_o3(p3d, q3d(:, :, :, i))
+!   Convert from mole fraction to mass fraction:
+    q3d(:, :, :, i) = q3d(:, :, :, i)  * 48. / 29.
+  end if
+
+!--- OZONE CLIMATOLOGY
+  IF(read_climoz>=1) CALL regr_lat_time_climoz(read_climoz)
+
+  x = 'tsol'; tsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'qsol';  qsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'snow';  sn(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'rads';  radsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'rugmer'; rugmer(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zmea';  zmea(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zstd';  zstd(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zsig';  zsig(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zgam';  zgam(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zthe';  zthe(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zpic';  zpic(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zval';  zval(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib)
+
+!  WRITE(lunout,'(48I3)') 'TSOL :', INT(tsol(2:klon)-273)
+
+! Soil ice file reading for soil fraction and soil ice fraction
+!*******************************************************************************
+  CALL flininfo("landiceref.nc", iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
+  ALLOCATE( lat_lic(iml_lic,jml_lic),lon_lic(iml_lic, jml_lic))
+  ALLOCATE(dlat_lic(jml_lic),       dlon_lic(iml_lic))
+  ALLOCATE( fraclic(iml_lic,jml_lic))
+  CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp,  &
+ &               lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
+  CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
+  CALL flinclo(fid)
+
+! Interpolation on model T-grid
+!*******************************************************************************
+  WRITE(lunout,*)'dimensions de landice iml_lic, jml_lic : ',iml_lic,jml_lic
+! conversion if coordinates are in degrees
+  IF(MAXVAL(lon_lic)>pi) lon_lic=lon_lic*pi/180.
+  IF(MAXVAL(lat_lic)>pi) lat_lic=lat_lic*pi/180.
+  dlon_lic(:)=lon_lic(:,1)
+  dlat_lic(:)=lat_lic(1,:)
+  CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1,   &
+ &               rlonv, rlatu, flic_tmp(1:iim,:) )
+  flic_tmp(iip1,:)=flic_tmp(1,:)
+
+!--- To the physical grid
+  CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, pctsrf(:,is_lic))
+
+!--- Adequation with soil/sea mask
+  WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. 
+  WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
+  pctsrf(:,is_ter)=zmasq(:)
+  DO ji=1,klon
+    IF(zmasq(ji)>EPSFRA) THEN 
+      IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
+        pctsrf(ji,is_lic)=zmasq(ji)
+        pctsrf(ji,is_ter)=0.
+      ELSE
+        pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
+        IF(pctsrf(ji,is_ter)<EPSFRA) THEN
+          pctsrf(ji,is_ter)=0.
+          pctsrf(ji,is_lic)=zmasq(ji)
+        END IF 
+      END IF 
+    END IF 
+  END DO 
+
+! sub-surface ocean and sea ice (sea ice set to zero for start)
+!*******************************************************************************
+  pctsrf(:,is_oce)=(1.-zmasq(:))
+  WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
+  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
+  isst=0
+  WHERE(pctsrf(2:klon-1,is_oce)>0.) isst=1
+
+! It is checked that the sub-surfaces sum is equal to 1
+!*******************************************************************************
+  ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
+  IF(ji/=0) WRITE(lunout,*) 'pb repartition sous maille pour ',ji,' points'
+  CALL gr_fi_ecrit(1, klon, iim, jjp1, zmasq, zx_tmp_2d)
+!  WRITE(fmt,"(i3,')')")iim; fmt='(i'//ADJUSTL(fmt)
+!  WRITE(lunout,*)'zmasq = '
+!  WRITE(lunout,TRIM(fmt))NINT(zx_tmp_2d)
+  CALL gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
+  WRITE(fmt,"(i4,'i1)')")iip1 ; fmt='('//ADJUSTL(fmt)
+  WRITE(lunout,*) 'MASQUE construit : Masque'
+  WRITE(lunout,TRIM(fmt))NINT(masque(:,:))
+
+! Intermediate computation
+!*******************************************************************************
+  CALL massdair(p3d,masse)
+  WRITE(lunout,*)' ALPHAX ',alphax
+  DO l=1,llm
+    xppn(:)=aire(1:iim,1   )*masse(1:iim,1   ,l)
+    xpps(:)=aire(1:iim,jjp1)*masse(1:iim,jjp1,l)
+    xpn=SUM(xppn)/apoln
+    xps=SUM(xpps)/apols
+    masse(:,1   ,l)=xpn
+    masse(:,jjp1,l)=xps
+  END DO
+  q3d(iip1,:,:,:)=q3d(1,:,:,:)
+  phis(iip1,:) = phis(1,:)
+
+  IF(.NOT.letat0) RETURN
+
+! Writing
+!*******************************************************************************
+  CALL inidissip(lstardis,nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,tetatemp)
+  WRITE(lunout,*)'sortie inidissip'
+  itau=0
+  itau_dyn=0
+  itau_phy=0
+  iday=dayref+itau/day_step
+  time=FLOAT(itau-(iday-dayref)*day_step)/day_step
+  IF(time>1.) THEN
+   time=time-1
+   iday=iday+1
+  END IF
+  day_ref=dayref
+  annee_ref=anneeref
+
+  CALL geopot( ip1jmp1, tpot, pk, pks, phis, phi )
+  WRITE(lunout,*)'sortie geopot'
+
+  CALL caldyn0( itau, uvent, vvent, tpot, psol, masse, pk, phis,               &
+                phi,  w, pbaru, pbarv, time+iday-dayref)
+  WRITE(lunout,*)'sortie caldyn0'     
+  CALL dynredem0( "start.nc", dayref, phis)
+  WRITE(lunout,*)'sortie dynredem0'
+  CALL dynredem1( "start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
+  WRITE(lunout,*)'sortie dynredem1' 
+
+! Physical initial state writting
+!*******************************************************************************
+  WRITE(lunout,*)'phystep ',dtvr,iphysiq,nbapp_rad
+  phystep   = dtvr * FLOAT(iphysiq)
+  radpas    = NINT (86400./phystep/ FLOAT(nbapp_rad) )
+  WRITE(lunout,*)'phystep =', phystep, radpas
+
+! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
+!*******************************************************************************
+  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
+  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
+  falb1(:,is_ter) = 0.08; falb1(:,is_lic) = 0.6
+  falb1(:,is_oce) = 0.5;  falb1(:,is_sic) = 0.6
+  falb2 = falb1
+  evap(:,:) = 0.
+  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
+  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
+  rain_fall = 0.; snow_fall = 0.
+  solsw = 165.;   sollw = -53.
+  t_ancien = 273.15
+  q_ancien = 0.
+  agesno = 0.
+  frugs(:,is_oce) = rugmer(:)
+  frugs(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+  frugs(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+  frugs(:,is_sic) = 0.001
+  fder = 0.0
+  clwcon = 0.0
+  rnebcon = 0.0
+  ratqs = 0.0
+  run_off_lic_0 = 0.0 
+  rugoro = 0.0
+
+! Before phyredem calling, surface modules and values to be saved in startphy.nc
+! are initialized
+!*******************************************************************************
+  dummy = 1.0
+  pbl_tke(:,:,:) = 1.e-8 
+  zmax0(:) = 40.
+  f0(:) = 1.e-5
+  ema_work1(:,:) = 0.
+  ema_work2(:,:) = 0.
+  wake_deltat(:,:) = 0.
+  wake_deltaq(:,:) = 0.
+  wake_s(:) = 0.
+  wake_cstar(:) = 0.
+  wake_fip(:) = 0.
+  wake_pe = 0.
+  fm_therm = 0.
+  entr_therm = 0.
+  detr_therm = 0.
+
+  CALL fonte_neige_init(run_off_lic_0)
+  CALL pbl_surface_init( qsol, fder, snsrf, qsolsrf, evap, frugs, agesno, tsoil )
+  CALL phyredem( "startphy.nc" )
+
+!  WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
+!  WRITE(lunout,*)'entree histclo'
+  CALL histclo()
+
+#endif 
+!#endif of #ifdef CPP_EARTH
+  RETURN
+
+END SUBROUTINE etat0_netcdf
+!
+!-------------------------------------------------------------------------------
Index: LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id$
+! $Id: exner_hyb.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
Index: LMDZ5/trunk/libf/dyn3dmem/exner_hyb_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/exner_hyb_p.F	(revision 1657)
+++ 	(revision )
@@ -1,153 +1,0 @@
-      SUBROUTINE  exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
-c
-c     Auteurs :  P.Le Van  , Fr. Hourdin  .
-c    ..........
-c
-c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
-c    .... alpha,beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
-c
-c   ************************************************************************
-c    Calcule la fonction d'Exner pk = Cp * p ** kappa , aux milieux des 
-c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
-c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
-c   ************************************************************************
-c  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
-c    la pression et la fonction d'Exner  au  sol  .
-c
-c                                 -------- z                                   
-c    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
-c                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
-c    ( voir note de Fr.Hourdin )  ,
-c
-c    on determine successivement , du haut vers le bas des couches, les 
-c    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2), 
-c    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches,  
-c     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
-c
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "comvert.h"
-#include "serre.h"
-
-      INTEGER  ngrid
-      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
-      REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
-
-c    .... variables locales   ...
-
-      INTEGER l, ij
-      REAL unpl2k,dellta
-
-      REAL ppn(iim),pps(iim)
-      REAL xpn, xps
-      REAL SSUM
-      EXTERNAL SSUM
-      INTEGER ije,ijb,jje,jjb
-c
-c$OMP BARRIER           
-      unpl2k    = 1.+ 2.* kappa
-c
-      ijb=ij_begin
-      ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC)
-      DO   ij  = ijb, ije
-        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-      ENDDO
-c$OMP ENDDO
-c Synchro OPENMP ici
-
-c$OMP MASTER
-      if (pole_nord) then
-        DO  ij   = 1, iim
-          ppn(ij) = aire(   ij   ) * pks(  ij     )
-        ENDDO
-        xpn      = SSUM(iim,ppn,1) /apoln
-  
-        DO ij   = 1, iip1
-          pks(   ij     )  =  xpn
-        ENDDO
-      endif
-      
-      if (pole_sud) then
-        DO  ij   = 1, iim
-          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-        ENDDO
-        xps      = SSUM(iim,pps,1) /apols 
-  
-        DO ij   = 1, iip1
-          pks( ij+ip1jm )  =  xps
-        ENDDO
-      endif
-c$OMP END MASTER
-c
-c
-c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
-c
-c$OMP DO SCHEDULE(STATIC)
-      DO     ij      = ijb,ije
-       alpha(ij,llm) = 0.
-       beta (ij,llm) = 1./ unpl2k
-      ENDDO
-c$OMP ENDDO NOWAIT
-c
-c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
-c
-      DO l = llm -1 , 2 , -1
-c
-c$OMP DO SCHEDULE(STATIC)
-        DO ij = ijb, ije
-        dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
-        alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
-        beta (ij,l)  =   p(ij,l  ) / dellta   
-        ENDDO
-c$OMP ENDDO NOWAIT
-c
-      ENDDO
-
-c
-c  ***********************************************************************
-c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
-c
-c$OMP DO SCHEDULE(STATIC)
-      DO   ij   = ijb, ije
-       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
-     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
-      ENDDO
-c$OMP ENDDO NOWAIT
-c
-c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
-c
-      DO l = 2, llm
-c$OMP DO SCHEDULE(STATIC)
-        DO   ij   = ijb, ije
-         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
-        ENDDO
-c$OMP ENDDO NOWAIT        
-      ENDDO
-c
-c
-c      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-      DO l = 1, llm
-c$OMP DO SCHEDULE(STATIC)
-         DO   ij   = ijb, ije
-           pkf(ij,l)=pk(ij,l)
-         ENDDO
-c$OMP ENDDO NOWAIT             
-      ENDDO
-
-c$OMP BARRIER
-      
-      jjb=jj_begin
-      jje=jj_end
-      CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
-      
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/exner_milieu_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/exner_milieu_p.F	(revision 1657)
+++ 	(revision )
@@ -1,224 +1,0 @@
-!
-! $Id $
-!
-      SUBROUTINE  exner_milieu_p ( ngrid, ps, p,beta, pks, pk, pkf )
-c
-c     Auteurs :  F. Forget , Y. Wanherdrick
-c P.Le Van  , Fr. Hourdin  .
-c    ..........
-c
-c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
-c    .... beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
-c
-c   ************************************************************************
-c    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des 
-c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
-c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
-c   ************************************************************************
-c    .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
-c    la pression et la fonction d'Exner  au  sol  .
-c
-c     WARNING : CECI est une version speciale de exner_hyb originale
-c               Utilise dans la version martienne pour pouvoir 
-c               tourner avec des coordonnees verticales complexe
-c              => Il ne verifie PAS la condition la proportionalite en 
-c              energie totale/ interne / potentielle (F.Forget 2001)
-c    ( voir note de Fr.Hourdin )  ,
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "comvert.h"
-#include "serre.h"
-
-      INTEGER  ngrid
-      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
-      REAL ps(ngrid),pks(ngrid), beta(ngrid,llm)
-
-c    .... variables locales   ...
-
-      INTEGER l, ij
-      REAL dum1
-
-      REAL ppn(iim),pps(iim)
-      REAL xpn, xps
-      REAL SSUM
-      EXTERNAL SSUM
-      INTEGER ije,ijb,jje,jjb
-      logical,save :: firstcall=.true.
-!$OMP THREADPRIVATE(firstcall) 
-      character(len=*),parameter :: modname="exner_milieu_p"
-
-      ! Sanity check
-      if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.2) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==2",42)
-        endif
-        
-        ! sanity checks for Shallow Water case (1 vertical layer)
-        if (llm.eq.1) then
-          if (kappa.ne.1) then
-            call abort_gcm(modname,
-     &      "kappa!=1 , but running in Shallow Water mode!!",42)
-          endif
-          if (cpp.ne.r) then
-            call abort_gcm(modname,
-     &      "cpp!=r , but running in Shallow Water mode!!",42)
-          endif
-        endif ! of if (llm.eq.1)
-
-        firstcall=.false.
-      endif ! of if (firstcall)
-      
-c$OMP BARRIER
-
-! Specific behaviour for Shallow Water (1 vertical layer) case
-      if (llm.eq.1) then
-              
-        ! Compute pks(:),pk(:),pkf(:)
-        ijb=ij_begin
-        ije=ij_end
-!$OMP DO SCHEDULE(STATIC)
-        DO ij=ijb, ije
-          pks(ij)=(cpp/preff)*ps(ij)
-          pk(ij,1) = .5*pks(ij)
-          pkf(ij,1)=pk(ij,1)
-        ENDDO
-!$OMP ENDDO
-
-!$OMP MASTER
-      if (pole_nord) then
-        DO  ij   = 1, iim
-          ppn(ij) = aire(   ij   ) * pks(  ij     )
-        ENDDO
-        xpn      = SSUM(iim,ppn,1) /apoln
-  
-        DO ij   = 1, iip1
-          pks(   ij     )  =  xpn
-          pk(ij,1) = .5*pks(ij)
-          pkf(ij,1)=pk(ij,1)
-        ENDDO
-      endif
-      
-      if (pole_sud) then
-        DO  ij   = 1, iim
-          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-        ENDDO
-        xps      = SSUM(iim,pps,1) /apols 
-  
-        DO ij   = 1, iip1
-          pks( ij+ip1jm )  =  xps
-          pk(ij+ip1jm,1)=.5*pks(ij+ip1jm)
-          pkf(ij+ip1jm,1)=pk(ij+ip1jm,1)
-        ENDDO
-      endif
-!$OMP END MASTER
-
-        jjb=jj_begin
-        jje=jj_end
-        CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
-
-        ! our work is done, exit routine
-        return
-      endif ! of if (llm.eq.1)
-
-!!!! General case:
-
-c     -------------
-c     Calcul de pks
-c     -------------
-   
-      ijb=ij_begin
-      ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC)
-      DO   ij  = ijb, ije
-        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-      ENDDO
-c$OMP ENDDO
-c Synchro OPENMP ici
-
-c$OMP MASTER
-      if (pole_nord) then
-        DO  ij   = 1, iim
-          ppn(ij) = aire(   ij   ) * pks(  ij     )
-        ENDDO
-        xpn      = SSUM(iim,ppn,1) /apoln
-  
-        DO ij   = 1, iip1
-          pks(   ij     )  =  xpn
-        ENDDO
-      endif
-      
-      if (pole_sud) then
-        DO  ij   = 1, iim
-          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-        ENDDO
-        xps      = SSUM(iim,pps,1) /apols 
-  
-        DO ij   = 1, iip1
-          pks( ij+ip1jm )  =  xps
-        ENDDO
-      endif
-c$OMP END MASTER
-c
-c
-c    .... Calcul de pk  pour la couche l 
-c    --------------------------------------------
-c
-      dum1 = cpp * (2*preff)**(-kappa) 
-      DO l = 1, llm-1
-c$OMP DO SCHEDULE(STATIC)
-        DO   ij   = ijb, ije
-         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
-        ENDDO
-c$OMP ENDDO NOWAIT        
-      ENDDO
-
-c    .... Calcul de pk  pour la couche l = llm ..
-c    (on met la meme distance (en log pression)  entre Pk(llm)
-c    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
-
-c$OMP DO SCHEDULE(STATIC)
-      DO   ij   = ijb, ije
-         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
-      ENDDO
-c$OMP ENDDO NOWAIT        
-
-
-c    calcul de pkf
-c    -------------
-c      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-      DO l = 1, llm
-c$OMP DO SCHEDULE(STATIC)
-         DO   ij   = ijb, ije
-           pkf(ij,l)=pk(ij,l)
-         ENDDO
-c$OMP ENDDO NOWAIT             
-      ENDDO
-
-c$OMP BARRIER
-      
-      jjb=jj_begin
-      jje=jj_end
-      CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
-      
-c    EST-CE UTILE ?? : calcul de beta
-c    --------------------------------
-      DO l = 2, llm
-c$OMP DO SCHEDULE(STATIC)
-        DO   ij   = ijb, ije
-          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
-        ENDDO
-c$OMP ENDDO NOWAIT             
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/extrapol.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/extrapol.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/extrapol.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: extrapol.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: extrapol.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 C
Index: LMDZ5/trunk/libf/dyn3dmem/friction_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/friction_p.F	(revision 1657)
+++ 	(revision )
@@ -1,143 +1,0 @@
-!
-! $Id: friction_p.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-c=======================================================================
-      SUBROUTINE friction_p(ucov,vcov,pdt)
-      USE parallel
-      USE control_mod
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c
-c   Objet:
-c   ------
-c
-c  ***********
-c    Friction
-c  ***********
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "comconst.h"
-
-      REAL pdt
-      REAL modv(iip1,jjp1),zco,zsi
-      REAL vpn,vps,upoln,upols,vpols,vpoln
-      REAL u2(iip1,jjp1),v2(iip1,jjm)
-      REAL ucov( iip1,jjp1,llm ),vcov( iip1,jjm,llm )
-      INTEGER  i,j
-      REAL cfric
-      parameter (cfric=1.e-5)
-      integer :: jjb,jje
-
-
-c   calcul des composantes au carre du vent naturel
-      jjb=jj_begin
-      jje=jj_end+1
-      if (pole_sud) jje=jj_end
-      
-      do j=jjb,jje
-         do i=1,iip1
-            u2(i,j)=ucov(i,j,1)*ucov(i,j,1)*unscu2(i,j)
-         enddo
-      enddo
-      
-      jjb=jj_begin-1
-      jje=jj_end+1
-      if (pole_nord) jjb=jj_begin
-      if (pole_sud) jje=jj_end-1
-      
-      do j=jjb,jje
-         do i=1,iip1
-            v2(i,j)=vcov(i,j,1)*vcov(i,j,1)*unscv2(i,j)
-         enddo
-      enddo
-
-c   calcul du module de V en dehors des poles
-      jjb=jj_begin
-      jje=jj_end+1
-      if (pole_nord) jjb=jj_begin+1
-      if (pole_sud) jje=jj_end-1
-      
-      do j=jjb,jje
-         do i=2,iip1
-            modv(i,j)=sqrt(0.5*(u2(i-1,j)+u2(i,j)+v2(i,j-1)+v2(i,j)))
-         enddo
-         modv(1,j)=modv(iip1,j)
-      enddo
-
-c   les deux composantes du vent au pole sont obtenues comme
-c   premiers modes de fourier de v pres du pole
-      if (pole_nord) then
-      
-        upoln=0.
-        vpoln=0.
-     
-        do i=2,iip1
-           zco=cos(rlonv(i))*(rlonu(i)-rlonu(i-1))
-           zsi=sin(rlonv(i))*(rlonu(i)-rlonu(i-1))
-           vpn=vcov(i,1,1)/cv(i,1)
-           upoln=upoln+zco*vpn
-           vpoln=vpoln+zsi*vpn
-        enddo
-        vpn=sqrt(upoln*upoln+vpoln*vpoln)/pi
-        do i=1,iip1
-c          modv(i,1)=vpn
-           modv(i,1)=modv(i,2)
-        enddo
-
-      endif
-      
-      if (pole_sud) then
-      
-        upols=0.
-        vpols=0.
-        do i=2,iip1
-           zco=cos(rlonv(i))*(rlonu(i)-rlonu(i-1))
-           zsi=sin(rlonv(i))*(rlonu(i)-rlonu(i-1))
-           vps=vcov(i,jjm,1)/cv(i,jjm)
-           upols=upols+zco*vps
-           vpols=vpols+zsi*vps
-        enddo
-        vps=sqrt(upols*upols+vpols*vpols)/pi
-        do i=1,iip1
-c        modv(i,jjp1)=vps
-         modv(i,jjp1)=modv(i,jjm)
-        enddo
-      
-      endif
-      
-c   calcul du frottement au sol.
-
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_nord) jjb=jj_begin+1
-      if (pole_sud) jje=jj_end-1
-
-      do j=jjb,jje
-         do i=1,iim
-            ucov(i,j,1)=ucov(i,j,1)
-     s      -cfric*pdt*0.5*(modv(i+1,j)+modv(i,j))*ucov(i,j,1)
-         enddo
-         ucov(iip1,j,1)=ucov(1,j,1)
-      enddo
-      
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-      
-      do j=jjb,jje
-         do i=1,iip1
-            vcov(i,j,1)=vcov(i,j,1)
-     s      -cfric*pdt*0.5*(modv(i,j+1)+modv(i,j))*vcov(i,j,1)
-         enddo
-         vcov(iip1,j,1)=vcov(1,j,1)
-      enddo
-
-      RETURN
-      END
-
Index: LMDZ5/trunk/libf/dyn3dmem/fxhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/fxhyp.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/fxhyp.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: fxhyp.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: fxhyp.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/fxy.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/fxy.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/fxy.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: fxy.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: fxy.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
Index: LMDZ5/trunk/libf/dyn3dmem/fxysinus.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/fxysinus.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/fxysinus.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: fxysinus.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: fxysinus.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
Index: LMDZ5/trunk/libf/dyn3dmem/fyhyp.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/fyhyp.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/fyhyp.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: fyhyp.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: fyhyp.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/gcm.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/gcm.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/gcm.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: gcm.F 1397 2010-06-02 12:57:39Z emillour $
+! $Id: gcm.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
@@ -73,4 +73,5 @@
 #include "iniprint.h"
 #include "tracstoke.h"
+
 #ifdef INCA
 ! Only INCA needs these informations (from the Earth's physics)
Index: LMDZ5/trunk/libf/dyn3dmem/geopot_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/geopot_p.F	(revision 1657)
+++ 	(revision )
@@ -1,66 +1,0 @@
-      SUBROUTINE geopot_p ( ngrid, teta, pk, pks, phis, phi )
-      USE parallel
-      IMPLICIT NONE
-      
-      
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c    *******************************************************************
-c    ....   calcul du geopotentiel aux milieux des couches    .....
-c    *******************************************************************
-c
-c     ....   l'integration se fait de bas en haut  ....
-c
-c     .. ngrid,teta,pk,pks,phis sont des argum. d'entree pour le s-pg ..
-c              phi               est un  argum. de sortie pour le s-pg .
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-
-c   Arguments:
-c   ----------
-      INTEGER ngrid
-      REAL teta(ngrid,llm),pks(ngrid),phis(ngrid),pk(ngrid,llm) ,
-     *       phi(ngrid,llm)
-
-
-c   Local:
-c   ------
-      
-      INTEGER  l, ij,ijb,ije
-
-
-c-----------------------------------------------------------------------
-c     calcul de phi au niveau 1 pres du sol  .....
-      ijb=ij_begin
-      ije=ij_end+iip1
-      
-      IF (pole_sud)  ije=ij_end
-
-      DO  ij  = ijb, ije
-      phi( ij,1 ) = phis( ij ) + teta(ij,1) * ( pks(ij) - pk(ij,1) )
-      ENDDO
-
-c     calcul de phi aux niveaux superieurs  .......
-
-      DO  l = 2,llm
-        DO  ij    = ijb,ije
-        phi(ij,l) = phi(ij,l-1) + 0.5 * ( teta(ij,l)  + teta(ij,l-1) ) 
-     *                              *   (  pk(ij,l-1) -  pk(ij,l)    )
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/gr_u_scal_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/gr_u_scal_p.F	(revision 1657)
+++ 	(revision )
@@ -1,72 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_u_scal_p(nx,x_u,x_scal)
-c%W%    %G%
-c=======================================================================
-c
-c   Author:    Frederic Hourdin      original: 11/11/92
-c   -------
-c
-c   Subject:
-c   ------
-c
-c   Method:
-c   --------
-c
-c   Interface:
-c   ----------
-c
-c      Input:
-c      ------
-c
-c      Output:
-c      -------
-c
-c=======================================================================
-      USE parallel
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c   Arguments:
-c   ----------
-
-      INTEGER nx
-      REAL x_u(ip1jmp1,nx),x_scal(ip1jmp1,nx)
-
-c   Local:
-c   ------
-
-      INTEGER l,ij
-      INTEGER :: ijb,ije
-
-c-----------------------------------------------------------------------
-      ijb=ij_begin
-      ije=ij_end
-      
-      DO l=1,nx
-         DO ij=ijb+1,ije
-            x_scal(ij,l)=
-     s      (aireu(ij)*x_u(ij,l)+aireu(ij-1)*x_u(ij-1,l))
-     s      /(aireu(ij)+aireu(ij-1))
-         ENDDO
-      ENDDO
-
-cym      CALL SCOPY(nx*jjp1,x_scal(iip1,1),iip1,x_scal(1,1),iip1)
-      ijb=ij_begin
-      ije=ij_end
-
-      DO l=1,nx
-         DO ij=ijb,ije-iip1+1,iip1
-	   x_scal(ij,l)=x_scal(ij+iip1-1,l)
-	 ENDDO
-      ENDDO
-      RETURN
-      
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/gr_v_scal_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/gr_v_scal_p.F	(revision 1657)
+++ 	(revision )
@@ -1,79 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_v_scal_p(nx,x_v,x_scal)
-c%W%    %G%
-c=======================================================================
-c
-c   Author:    Frederic Hourdin      original: 11/11/92
-c   -------
-c
-c   Subject:
-c   ------
-c
-c   Method:
-c   --------
-c
-c   Interface:
-c   ----------
-c
-c      Input:
-c      ------
-c
-c      Output:
-c      -------
-c
-c=======================================================================
-      USE parallel
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c   Arguments:
-c   ----------
-
-      INTEGER nx
-      REAL x_v(ip1jm,nx),x_scal(ip1jmp1,nx)
-
-c   Local:
-c   ------
-
-      INTEGER l,ij
-      INTEGER :: ijb,ije
-c-----------------------------------------------------------------------
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) ijb=ij_begin+iip1
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO l=1,nx
-         DO ij=ijb,ije
-            x_scal(ij,l)=
-     s      (airev(ij-iip1)*x_v(ij-iip1,l)+airev(ij)*x_v(ij,l))
-     s      /(airev(ij-iip1)+airev(ij))
-         ENDDO
-      ENDDO
-      
-      if (pole_nord) then
-        DO l=1,nx
-           DO ij=1,iip1
-              x_scal(ij,l)=0.
-           ENDDO
-        ENDDO
-      endif
-    
-      if (pole_sud) then
-        DO l=1,nx
-           DO ij=ip1jm+1,ip1jmp1
-              x_scal(ij,l)=0.
-           ENDDO
-        ENDDO
-      endif
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/gradiv2_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/gradiv2_p.F	(revision 1657)
+++ 	(revision )
@@ -1,147 +1,0 @@
-      SUBROUTINE gradiv2_p(klevel, xcov, ycov, ld, gdx_out, gdy_out )
-c
-c     P. Le Van
-c
-c   **********************************************************
-c                                ld
-c       calcul  de  (grad (div) )   du vect. v ....
-c
-c     xcov et ycov etant les composant.covariantes de v
-c   **********************************************************
-c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
-c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
-c
-c
-      USE parallel
-      USE times
-      USE Write_field_p
-      USE mod_hallo
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comdissipn.h"
-c
-c     ........    variables en arguments      ........
-
-      INTEGER klevel
-      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
-      REAL,SAVE ::  gdx( ip1jmp1,llm ),  gdy( ip1jm,llm )
-      REAL   gdx_out( ip1jmp1,klevel ), gdy_out( ip1jm,klevel )
-c
-c     ........       variables locales       .........
-c
-      REAL,SAVE :: div(ip1jmp1,llm)
-      REAL      :: tmp_div2(ip1jmp1,llm)
-      REAL signe, nugrads
-      INTEGER l,ij,iter,ld
-      INTEGER :: ijb,ije,jjb,jje
-      Type(Request)  :: request_dissip
-      
-c    ........................................................
-c
-c
-c      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
-c      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
-      
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO   l = 1, klevel
-        gdx(ijb:ije,l)=xcov(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT      
-      
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO   l = 1, klevel
-        gdy(ijb:ije,l)=ycov(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-c$OMP BARRIER
-       call Register_Hallo(gdy,ip1jm,llm,1,0,0,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-c
-c
-      signe   = (-1.)**ld
-      nugrads = signe * cdivu
-c
-
-
-      CALL    divergf_p( klevel, gdx,   gdy , div )
-c      call write_field3d_p('div1',reshape(div,(/iip1,jjp1,llm/)))
-
-      IF( ld.GT.1 )   THEN
-c$OMP BARRIER
-       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-	CALL laplacien_p ( klevel, div,  div     )
-
-c    ......  Iteration de l'operateur laplacien_gam   .......
-c         call write_field3d_p('div2',reshape(div,(/iip1,jjp1,llm/)))
-
-        DO iter = 1, ld -2
-c$OMP BARRIER
-       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-
-c$OMP BARRIER
-
-         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
-     *                       unsapolnga1, unsapolsga1,  div, div       )
-        ENDDO
-c        call write_field3d_p('div3',reshape(div,(/iip1,jjp1,llm/)))
-      ENDIF
-
-       jjb=jj_begin
-       jje=jj_end
-       
-       CALL filtreg_p( div   ,jjb,jje, jjp1, klevel, 2, 1, .TRUE., 1 )
-c       call exchange_Hallo(div,ip1jmp1,llm,0,1)
-c$OMP BARRIER
-       call Register_Hallo(div,ip1jmp1,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-
-c$OMP BARRIER
-
-
-       CALL  grad_p  ( klevel,  div,   gdx,  gdy             )
-
-c
-      ijb=ij_begin
-      ije=ij_end
-         
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-       DO   l = 1, klevel
-         
-         if (pole_sud) ije=ij_end
-         DO  ij = ijb, ije
-          gdx_out( ij,l ) = gdx( ij,l ) * nugrads
-         ENDDO
-         
-         if (pole_sud) ije=ij_end-iip1
-         DO  ij = ijb, ije
-          gdy_out( ij,l ) = gdy( ij,l ) * nugrads
-         ENDDO
-       
-       ENDDO
-c$OMP END DO NOWAIT
-c
-       RETURN
-       END
Index: LMDZ5/trunk/libf/dyn3dmem/grid_atob.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/grid_atob.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/grid_atob.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: grid_atob.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: grid_atob.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
Index: LMDZ5/trunk/libf/dyn3dmem/grid_noro.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/grid_noro.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/grid_noro.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: grid_noro.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: grid_noro.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: grilles_gcm_netcdf.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: grilles_gcm_netcdf.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/guide_p_mod.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/guide_p_mod.F90	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/guide_p_mod.F90	(revision 1658)
@@ -390,9 +390,9 @@
               stop
           ELSE
-              IF (guide_v) vnat1(jjb_v:jje_v,:,:)=vnat2(jjb_v:jje_v,:,:)
-              IF (guide_u) unat1(jjb_u:jje_u,:,:)=unat2(jjb_u:jje_u,:,:)
-              IF (guide_T) tnat1(jjb_u:jje_u,:,:)=tnat2(jjb_u:jje_u,:,:)
-              IF (guide_Q) qnat1(jjb_u:jje_u,:,:)=qnat2(jjb_u:jje_u,:,:)
-              IF (guide_P.OR.guide_modele) psnat1(jjb_u:jje_u,:)=psnat2(jjb_u:jje_u,:)
+              IF (guide_v) vnat1(:,jjb_v:jje_v,:)=vnat2(:,jjb_v:jje_v,:)
+              IF (guide_u) unat1(:,jjb_u:jje_u,:)=unat2(:,jjb_u:jje_u,:)
+              IF (guide_T) tnat1(:,jjb_u:jje_u,:)=tnat2(:,jjb_u:jje_u,:)
+              IF (guide_Q) qnat1(:,jjb_u:jje_u,:)=qnat2(:,jjb_u:jje_u,:)
+              IF (guide_P.OR.guide_modele) psnat1(:,jjb_u:jje_u)=psnat2(:,jjb_u:jje_u)
               step_rea=step_rea+1
               itau_test=itau
@@ -1176,5 +1176,5 @@
 #endif
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,unat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,unat2)
          ENDIF
 
@@ -1189,5 +1189,5 @@
 #endif
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,tnat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
          ENDIF
      endif
@@ -1201,5 +1201,5 @@
 #endif
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,qnat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
          ENDIF
 
@@ -1215,5 +1215,5 @@
 #endif
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjm,llm,vnat2)
+           CALL invert_lat(iip1,jjm,nlevnc,vnat2)
          ENDIF
      endif
@@ -1364,5 +1364,5 @@
 
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,unat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,unat2)
          ENDIF
 
@@ -1381,5 +1381,5 @@
 
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,tnat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
          ENDIF
 
@@ -1398,5 +1398,5 @@
          
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,llm,qnat2)
+           CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
          ENDIF
 
@@ -1416,5 +1416,5 @@
 
          IF (invert_y) THEN
-           CALL invert_lat(iip1,jjm,llm,vnat2)
+           CALL invert_lat(iip1,jjm,nlevnc,vnat2)
          ENDIF
 
Index: LMDZ5/trunk/libf/dyn3dmem/iniacademic.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/iniacademic.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/iniacademic.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: iniacademic.F 1363 2010-04-16 09:50:10Z emillour $
+! $Id: iniacademic.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/iniconst.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/iniconst.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/iniconst.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: iniconst.F 1380 2010-05-06 12:24:59Z emillour $
+! $Id: iniconst.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE iniconst
Index: LMDZ5/trunk/libf/dyn3dmem/inidissip.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/inidissip.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/inidissip.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: inidissip.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: inidissip.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
Index: LMDZ5/trunk/libf/dyn3dmem/inigeom.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/inigeom.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/inigeom.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: inigeom.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: inigeom.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 c
Index: LMDZ5/trunk/libf/dyn3dmem/initdynav_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/initdynav_p.F	(revision 1657)
+++ 	(revision )
@@ -1,204 +1,0 @@
-!
-! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-      subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt,fileid)
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-       USE IOIPSL
-#endif
-       use parallel
-       use Write_field
-       use misc_mod
-       USE infotrac
-
-      implicit none
-
-C
-C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-C   au format IOIPSL. Initialisation du fichier histoire moyenne.
-C
-C   Appels succesifs des routines: histbeg
-C                                  histhori
-C                                  histver
-C                                  histdef
-C                                  histend
-C
-C   Entree:
-C
-C      infile: nom du fichier histoire a creer
-C      day0,anne0: date de reference
-C      tstep : frequence d'ecriture
-C      t_ops: frequence de l'operation pour IOIPSL
-C      t_wrt: frequence d'ecriture sur le fichier
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
-
-C   Arguments
-C
-      character*(*) infile
-      integer*4 day0, anne0
-      real tstep, t_ops, t_wrt
-      integer fileid
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-C   Variables locales
-C
-      integer thoriid, zvertiid
-      integer tau0
-      real zjulian
-      integer iq
-      real rlong(iip1,jjp1), rlat(iip1,jjp1)
-      integer ii,jj
-      integer zan, dayref
-      integer :: jjb,jje,jjn
-
-! definition du domaine d'ecriture pour le rebuild
-
-      INTEGER,DIMENSION(2) :: ddid
-      INTEGER,DIMENSION(2) :: dsg
-      INTEGER,DIMENSION(2) :: dsl
-      INTEGER,DIMENSION(2) :: dpf
-      INTEGER,DIMENSION(2) :: dpl
-      INTEGER,DIMENSION(2) :: dhs
-      INTEGER,DIMENSION(2) :: dhe 
-      
-      INTEGER :: dynave_domain_id
-      
-      if (adjust) return
-C
-C  Initialisations
-C
-      pi = 4. * atan (1.)
-C
-C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-C         
-
-      zan = anne0
-      dayref = day0
-      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
-      tau0 = itau_dyn
-      
-      do jj = 1, jjp1
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonv(ii) * 180. / pi
-          rlat(ii,jj)  = rlatu(jj) * 180. / pi
-        enddo
-      enddo
-
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-
-      ddid=(/ 1,2 /)
-      dsg=(/ iip1,jjp1 /)
-      dsl=(/ iip1,jjn /)
-      dpf=(/ 1,jjb /)
-      dpl=(/ iip1,jje /)
-      dhs=(/ 0,0 /)
-      dhe=(/ 0,0 /)
-
-      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 
-     .                 'box',dynave_domain_id)
-             
-      call histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
-     .             1, iip1, 1, jjn,tau0, zjulian, tstep, thoriid,
-     .             fileid,dynave_domain_id)
-
-C
-C  Appel a histvert pour la grille verticale
-C
-      call histvert(fileid, 'sigss', 'Niveaux sigma','Pa',
-     .              llm, nivsigs, zvertiid)
-C
-C  Appels a histdef pour la definition des variables a sauvegarder
-C
-C  Vents U
-C
-      write(6,*)'inithistave',tstep
-      call histdef(fileid, 'u', 'vents u scalaires moyennes',
-     .             'm/s', iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-C
-C  Vents V
-C
-      call histdef(fileid, 'v', 'vents v scalaires moyennes',
-     .             'm/s', iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-C
-C  Temperature
-C
-      call histdef(fileid, 'temp', 'temperature moyennee', 'K',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Temperature potentielle
-C
-      call histdef(fileid, 'theta', 'temperature potentielle', 'K',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-
-C
-C  Geopotentiel
-C
-      call histdef(fileid, 'phi', 'geopotentiel moyenne', '-',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Traceurs
-C
-        DO iq=1,nqtot
-          call histdef(fileid, ttext(iq), ttext(iq), '-',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-        enddo
-C
-C  Masse
-C
-      call histdef(fileid, 'masse', 'masse', 'kg',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Fin
-C
-      call histend(fileid)
-#else
-      write(lunout,*)'initdynav_p: Needs IOIPSL to function'
-#endif
-! #endif of #ifdef CPP_IOIPSL
-      return
-      end
Index: LMDZ5/trunk/libf/dyn3dmem/inithist_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/inithist_p.F	(revision 1657)
+++ 	(revision )
@@ -1,257 +1,0 @@
-!
-! $Id: inithist_p.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
-     .                      fileid,filevid)
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-       USE IOIPSL
-#endif
-       use parallel
-       use Write_field
-       use misc_mod
-       USE infotrac
-
-      implicit none
-
-C
-C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
-C   au format IOIPSL
-C
-C   Appels succesifs des routines: histbeg
-C                                  histhori
-C                                  histver
-C                                  histdef
-C                                  histend
-C
-C   Entree:
-C
-C      infile: nom du fichier histoire a creer
-C      day0,anne0: date de reference
-C      tstep: duree du pas de temps en seconde
-C      t_ops: frequence de l'operation pour IOIPSL
-C      t_wrt: frequence d'ecriture sur le fichier
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C      filevid:ID du fichier netcdf pour la grille v
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
-
-C   Arguments
-C
-      character*(*) infile
-      integer*4 day0, anne0
-      real tstep, t_ops, t_wrt
-      integer fileid, filevid
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-C   Variables locales
-C
-      integer tau0
-      real zjulian
-      integer iq
-      real rlong(iip1,jjp1), rlat(iip1,jjp1)
-      integer uhoriid, vhoriid, thoriid, zvertiid
-      integer ii,jj
-      integer zan, dayref
-      integer :: jjb,jje,jjn
-
-! definition du domaine d'ecriture pour le rebuild
-
-      INTEGER,DIMENSION(2) :: ddid
-      INTEGER,DIMENSION(2) :: dsg
-      INTEGER,DIMENSION(2) :: dsl
-      INTEGER,DIMENSION(2) :: dpf
-      INTEGER,DIMENSION(2) :: dpl
-      INTEGER,DIMENSION(2) :: dhs
-      INTEGER,DIMENSION(2) :: dhe 
-      
-      INTEGER :: dynu_domain_id
-      INTEGER :: dynv_domain_id
-
-C
-C  Initialisations
-C
-      if (adjust) return
-       
-      pi = 4. * atan (1.)
-C
-C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
-C         
-
-      zan = anne0
-      dayref = day0
-      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
-      tau0 = itau_dyn
-      
-      do jj = 1, jjp1
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonu(ii) * 180. / pi
-          rlat(ii,jj) = rlatu(jj) * 180. / pi
-        enddo
-      enddo
-      
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-
-
-      ddid=(/ 1,2 /)
-      dsg=(/ iip1,jjp1 /)
-      dsl=(/ iip1,jjn /)
-      dpf=(/ 1,jjb /)
-      dpl=(/ iip1,jje /)
-      dhs=(/ 0,0 /)
-      dhe=(/ 0,0 /)
-
-      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 
-     .                 'box',dynu_domain_id)
-      
-       call histbeg(trim(infile),iip1, rlong(:,1), jjn, 
-     .              rlat(1,jjb:jje), 1, iip1, 1, jjn, tau0,
-     .              zjulian, tstep, uhoriid, fileid,dynu_domain_id)
-C
-C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
-C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
-C  un meme fichier)
-
-      do jj = 1, jjm
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonv(ii) * 180. / pi
-          rlat(ii,jj) = rlatv(jj) * 180. / pi
-        enddo
-      enddo
-
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-      if (pole_sud) jje=jj_end-1
-      if (pole_sud) jjn=jj_nb-1
-
-      ddid=(/ 1,2 /)
-      dsg=(/ iip1,jjm /)
-      dsl=(/ iip1,jjn /)
-      dpf=(/ 1,jjb /)
-      dpl=(/ iip1,jje /)
-      dhs=(/ 0,0 /)
-      dhe=(/ 0,0 /)
-
-      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 
-     .                 'box',dynv_domain_id)
-      
-      call histbeg('dyn_histv', iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
-     .             1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid, 
-     .             filevid,dynv_domain_id)
-C
-C  Appel a histhori pour rajouter les autres grilles horizontales
-C
-      
-      do jj = 1, jjp1
-        do ii = 1, iip1
-          rlong(ii,jj) = rlonv(ii) * 180. / pi
-          rlat(ii,jj) = rlatu(jj) * 180. / pi
-        enddo
-      enddo
-
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-
-      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
-     .              'scalar','Grille points scalaires', thoriid)
-C
-C  Appel a histvert pour la grille verticale
-C
-      call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
-     .              llm, nivsigs, zvertiid)
-C Pour le fichier V
-      call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
-     .              llm, nivsigs, zvertiid)
-C
-C  Appels a histdef pour la definition des variables a sauvegarder
-C
-C  Vents U
-C
-      jjn=jj_nb
-
-      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
-     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Vents V
-C
-      if (pole_sud) jjn=jj_nb-1
-      
-      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
-     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-
-C
-C  Temperature potentielle
-C
-      jjn=jj_nb
-      
-      call histdef(fileid, 'teta', 'temperature potentielle', '-',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Geopotentiel
-C
-      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Traceurs
-C
-        DO iq=1,nqtot
-          call histdef(fileid, ttext(iq),  ttext(iq), '-',
-     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        enddo
-C
-C  Masse
-C
-      call histdef(fileid, 'masse', 'masse', 'kg',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
-     .             iip1, jjn, thoriid, 1, 1, 1, -99,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
-C  Fin
-C
-      call histend(fileid)
-      call histend(filevid)
-#else
-      write(lunout,*)'inithist_p: Needs IOIPSL to function'
-#endif
-! #endif of #ifdef CPP_IOIPSL
-      return
-      end
Index: LMDZ5/trunk/libf/dyn3dmem/inter_barxy_m.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/inter_barxy_m.F90	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/inter_barxy_m.F90	(revision 1658)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
 module inter_barxy_m
 
@@ -36,5 +39,5 @@
     ! jjm+1 latitudes rlatu du modele (latitudes des scalaires et de U)
     ! Si taille de la seconde dim = jjm, on veut interpoler sur les
-    ! jjm latitudes rlatv du modèle (latitudes de V) 
+    ! jjm latitudes rlatv du modele (latitudes de V) 
 
     ! Variables local to the procedure:
@@ -112,5 +115,5 @@
     !     rlonimod(imod): abscisses des interfaces des mailles modele
     !      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
-    !      ( Les abscisses sont exprimées en degres)
+    !      ( Les abscisses sont exprimees en degres)
 
     use assert_eq_m, only: assert_eq
@@ -118,7 +121,7 @@
     IMPLICIT NONE
 
-    REAL, intent(in):: dlonid(:) ! dim(idatmax)
-    real, intent(in):: fdat(:) ! dim(idatmax)
-    real, intent(in):: rlonimod(:) ! dim(imodmax)
+    REAL, intent(in):: dlonid(:)
+    real, intent(in):: fdat(:)
+    real, intent(in):: rlonimod(:)
 
     real inter_barx(size(rlonimod))
@@ -292,7 +295,7 @@
   function inter_bary(yjdat, fdat, yjmod)
 
-    ! Interpolation barycentrique basée sur les aires.
+    ! Interpolation barycentrique basee sur les aires.
     ! Version unidimensionnelle, en latitude.
-    ! L'indice 1 correspond à l'interface maille 1 -- maille 2.
+    ! L'indice 1 correspond a l'interface maille 1 -- maille 2.
 
     use assert_m, only: assert
@@ -301,20 +304,20 @@
 
     REAL, intent(in):: yjdat(:)
-    ! (angles, ordonnées des interfaces des mailles des données, in
+    ! (angles, ordonnees des interfaces des mailles des donnees, in
     ! degrees, in increasing order)
 
-    REAL, intent(in):: fdat(:) ! champ de données
+    REAL, intent(in):: fdat(:) ! champ de donnees
 
     REAL, intent(in):: yjmod(:)
-    ! (ordonnées des interfaces des mailles du modèle)
+    ! (ordonnees des interfaces des mailles du modele)
     ! (in degrees, in strictly increasing order)
 
-    REAL inter_bary(size(yjmod)) ! champ du modèle
+    REAL inter_bary(size(yjmod)) ! champ du modele
 
     ! Variables local to the procedure:
 
     REAL y0, dy, dym 
-    INTEGER jdat ! indice du champ de données
-    integer jmod ! indice du champ du modèle
+    INTEGER jdat ! indice du champ de donnees
+    integer jmod ! indice du champ du modele
 
     !------------------------------------
Index: LMDZ5/trunk/libf/dyn3dmem/interpre.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/interpre.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/interpre.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: interpre.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: interpre.F 1403 2010-07-01 09:02:53Z fairhead $
 !
        subroutine interpre(q,qppm,w,fluxwppm,masse,
Index: LMDZ5/trunk/libf/dyn3dmem/laplacien_gam_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/laplacien_gam_p.F	(revision 1657)
+++ 	(revision )
@@ -1,65 +1,0 @@
-      SUBROUTINE laplacien_gam_p ( klevel, cuvsga, cvusga, unsaigam ,
-     *                        unsapolnga, unsapolsga, teta, divgra )
-
-c  P. Le Van
-c
-c   ************************************************************
-c
-c      ....   calcul de  (div( grad ))   de   teta  .....
-c   ************************************************************
-c    klevel et teta  sont des arguments  d'entree pour le s-prog
-c      divgra     est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c
-c    ............     variables  en arguments    ..........
-c
-      INTEGER klevel
-      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
-      REAL cuvsga(ip1jm) , cvusga( ip1jmp1 ),unsaigam(ip1jmp1),
-     *     unsapolnga, unsapolsga
-c
-c    ...........    variables  locales    .................
-c
-      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
-c    ......................................................
-
-      INTEGER :: ijb,ije
-      INTEGER :: l      
-c
-c
-c   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
-c   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
-c   ...  unsairegam =  1. /  aire ** (- gamdissip )
-c
-
-c      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
-      
-      ijb=ij_begin-iip1
-      ije=ij_end+iip1
-      if (pole_nord) ijb=ij_begin
-      if (pole_sud ) ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,klevel      
-        divgra(ijb:ije,l)=teta(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-c
-      CALL   grad_p ( klevel, divgra, ghx, ghy )
-c
-      CALL  diverg_gam_p ( klevel, cuvsga, cvusga,  unsaigam  ,
-     *                 unsapolnga, unsapolsga, ghx , ghy , divgra )
-
-c
-
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/laplacien_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/laplacien_p.F	(revision 1657)
+++ 	(revision )
@@ -1,56 +1,0 @@
-      SUBROUTINE laplacien_p ( klevel, teta, divgra )
-c
-c     P. Le Van
-c
-c   ************************************************************
-c    ....     calcul de  (div( grad ))   de   teta  .....
-c   ************************************************************
-c     klevel et teta  sont des arguments  d'entree pour le s-prog
-c      divgra     est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c
-c    .........      variables  en arguments   ..............
-c
-      INTEGER klevel
-      REAL teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
-      INTEGER :: l
-c
-c    ............     variables  locales      ..............
-c
-      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
-c    .......................................................
-
-      
-      INTEGER :: ijb,ije,jjb,jje
-c
-c      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
-
-      ijb=ij_begin-iip1
-      ije=ij_end+iip1
-      if (pole_nord) ijb=ij_begin
-      if (pole_sud ) ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l=1,klevel      
-        divgra(ijb:ije,l)=teta(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-      
-      jjb=jj_begin-1
-      jje=jj_end+1
-      if (pole_nord) jjb=jj_begin
-      if (pole_sud ) jje=jj_end
-      
-      CALL filtreg_p( divgra,jjb,jje,jjp1, klevel,  2, 1, .TRUE., 1 )
-      CALL   grad_p ( klevel,divgra,   ghx , ghy              )
-      CALL  divergf_p ( klevel, ghx , ghy  , divgra           )
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/laplacien_rot_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/laplacien_rot_p.F	(revision 1657)
+++ 	(revision )
@@ -1,45 +1,0 @@
-      SUBROUTINE laplacien_rot_p ( klevel, rotin, rotout,ghx,ghy )
-c
-c    P. Le Van
-c
-c   ************************************************************
-c    ...  calcul de  ( rotat x nxgrad )  du rotationnel rotin  .
-c   ************************************************************
-c
-c     klevel et rotin  sont des arguments  d'entree pour le s-prog
-c      rotout           est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c 
-c   ..........    variables  en  arguments     .............
-c
-      INTEGER klevel
-      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
-c
-c   ..........    variables   locales       ................
-c
-      REAL ghy(ip1jm,klevel), ghx(ip1jmp1,klevel)
-c   ........................................................
-c
-c
-      INTEGER :: ijb,ije,jjb,jje
-      
-      jjb=jj_begin-1
-      jje=jj_end+1
-      
-      if (pole_nord) jjb=jj_begin
-      if (pole_sud) jje=jj_end-1
-      
-      CALL  filtreg_p ( rotin ,jjb,jje,jjm, klevel,2, 1, .FALSE., 1)
-
-      CALL   nxgrad_p ( klevel, rotin,   ghx ,  ghy               )
-      CALL   rotatf_p  ( klevel, ghx  ,   ghy , rotout             )
-c
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/laplacien_rotgam_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/laplacien_rotgam_p.F	(revision 1657)
+++ 	(revision )
@@ -1,48 +1,0 @@
-      SUBROUTINE laplacien_rotgam_p ( klevel, rotin, rotout )
-c
-c     P. Le Van
-c
-c   ************************************************************
-c   ... calcul de  (rotat x nxgrad)_gam  du rotationnel rotin ..
-c   ************************************************************
-c     klevel et teta  sont des arguments  d'entree pour le s-prog
-c      divgra     est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-c
-c    .............   variables  en  arguments    ...........
-c
-      INTEGER klevel
-      REAL rotin( ip1jm,klevel ), rotout( ip1jm,klevel )
-c
-c   ............     variables   locales     ...............
-c
-      INTEGER l, ij
-      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
-c   ........................................................
-c
-      INTEGER :: ijb,ije
-      
-c
-
-      CALL   nxgrad_gam_p ( klevel, rotin,   ghx ,   ghy  )
-      CALL   rotat_nfil_p ( klevel, ghx  ,   ghy , rotout )
-c
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO l = 1, klevel
-        DO ij = ijb, ije
-         rotout(ij,l) = rotout(ij,l) * unsairz_gam(ij)
-        ENDDO
-      ENDDO
-c$OMP END DO NOWAIT
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F	(revision 1657)
+++ 	(revision )
@@ -1,1332 +1,0 @@
-!
-! $Id: limit_netcdf.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-C
-C
-      SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque)
-#ifdef CPP_EARTH
-! This routine is designed to work for Earth
-      USE dimphy
-      USE control_mod
-      use phys_state_var_mod , ONLY : pctsrf
-      use inter_barxy_m, only: inter_barxy
-
-      IMPLICIT none
-c
-c-------------------------------------------------------------
-C Author : L. Fairhead
-C Date   : 27/01/94
-C Objet  : Construction des fichiers de conditions aux limites
-C          pour le nouveau
-C          modele a partir de fichiers de climatologie. Les deux
-C          grilles doivent etre regulieres
-c
-c Modifie par z.x.li (le23mars1994)
-c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
-c                         pour lecture netcdf dans LMDZ.3.3
-c Modifie par P;Le Van  ,  juillet 2001
-c-------------------------------------------------------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "netcdf.inc"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "comconst.h"
-cy#include "dimphy.h"
-#include "indicesol.h"
-#include "iniprint.h"
-c
-c-----------------------------------------------------------------------
-      LOGICAL interbar, extrap, oldice
-
-      REAL phy_nat(klon,360), phy_nat0(klon)
-      REAL phy_alb(klon,360)
-      REAL phy_sst(klon,360)
-      REAL phy_bil(klon,360)
-      REAL phy_rug(klon,360)
-      REAL phy_ice(klon)
-c
-      real pctsrf_t(klon,nbsrf,360)
-
-      REAL verif
-
-      REAL masque(iip1,jjp1)
-      REAL mask(iim,jjp1)
-CPB
-C newlmt indique l'utilisation de la sous-maille fractionnelle
-C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
-      LOGICAL newlmt, fracterre
-      PARAMETER(newlmt=.TRUE.)
-      PARAMETER(fracterre = .TRUE.) 
-
-C Declarations pour le champ de depart
-      INTEGER imdep, jmdep,lmdep
-      INTEGER  tbid
-      PARAMETER ( tbid = 60 )        ! >52 semaines
-      REAL  timecoord(tbid)
-c
-      REAL , ALLOCATABLE :: dlon_msk(:), dlat_msk(:)
-      REAL , ALLOCATABLE :: lonmsk_ini(:), latmsk_ini(:)
-      REAL , ALLOCATABLE :: dlon(:), dlat(:)
-      REAL , ALLOCATABLE :: dlon_ini(:), dlat_ini(:)
-      REAL , ALLOCATABLE :: champ_msk(:), champ(:, :)
-      REAL , ALLOCATABLE :: work(:,:)
-
-      CHARACTER*25 title
-
-C Declarations pour le champ interpole 2D
-      REAL champint(iim,jjp1)
-      real chmin,chmax
-
-C Declarations pour le champ interpole 3D
-      REAL champtime(iim,jjp1,tbid)
-      REAL timeyear(tbid)
-      REAL champan(iip1,jjp1,366)
-
-C Declarations pour l'inteprolation verticale
-      REAL ax(tbid), ay(tbid)
-      REAL by
-      REAL yder(tbid)
-
-
-      INTEGER ierr
-      INTEGER dimfirst(3)
-      INTEGER dimlast(3)
-c
-      INTEGER nid, ndim, ntim
-      INTEGER dims(2), debut(2), epais(2)
-      INTEGER id_tim
-      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
-CPB
-      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
-
-      INTEGER i, j, k, l, ji
-c declarations pour lecture glace de mer
-      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
-      INTEGER :: itaul(1), fid
-      REAL :: lev(1), date, dt
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
-      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
-      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
-      REAL :: flic_tmp(iip1, jjp1)
-
-c Diverses variables locales
-      REAL time
-! pour la lecture du fichier masque ocean
-      integer :: nid_o2a
-      logical :: couple = .false.
-      INTEGER :: iml_omask, jml_omask
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
-      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
-      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
-      real, dimension(klon) :: ocemask_fi
-
-      INTEGER          longcles
-      PARAMETER      ( longcles = 20 )
-      REAL  clesphy0 ( longcles      )
-#include "serre.h"
-      INTEGER ncid,varid,ndimid(4),dimid
-      character*30 namedim
-      CHARACTER*80 :: varname
-
-cIM28/02/2002 <== PM
-      REAL tmidmonth(12)
-      SAVE tmidmonth
-      DATA tmidmonth/15,45,75,105,135,165,195,225,255,285,315,345/
-
-c initialisations:
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
-
-
-      pi     = 4. * ATAN(1.)
-      rad    = 6 371 229.
-      omeg   = 4.* ASIN(1.)/(24.*3600.)
-      g      = 9.8
-      daysec = 86400.
-      kappa  = 0.2857143
-      cpp    = 1004.70885
-      dtvr    = daysec/ REAL(day_step)
-      CALL inigeom
-c
-C Traitement du relief au sol
-c
-      write(*,*) 'Traitement du relief au sol pour fabriquer masque'
-      ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
-
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-      ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      print*,'variable ', namedim, 'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-      ALLOCATE( lonmsk_ini(imdep) )
-      ALLOCATE(   dlon_msk(imdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
-#endif
-
-c
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      print*,'variable ', namedim, 'dimension ', jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-      ALLOCATE( latmsk_ini(jmdep) )
-      ALLOCATE(   dlat_msk(jmdep) )
-      ALLOCATE(  champ_msk(imdep*jmdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
-#endif
-c
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
-#endif
-c
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-c
-      title='RELIEF'
-
-      CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
-     . dlon_msk, dlat_msk, champ_msk, interbar  )
-
-      DO i = 1, iim
-      DO j = 1, jjp1
-         mask(i,j) = masque(i,j)
-      ENDDO
-      ENDDO
-      WRITE(*,*) 'MASK:'
-      WRITE(*,'(96i1)')INT(mask)     
-      ierr = NF_CLOSE(ncid)
-c
-c
-C Traitement de la rugosite
-c
-      PRINT*, 'Traitement de la rugosite'
-      ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-      ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE( dlon_ini(imdep) )
-      ALLOCATE(     dlon(imdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE( dlat_ini(jmdep) )
-      ALLOCATE(     dlat(jmdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      print*,'variable ', namedim, 'dimension ', lmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-c
-      ALLOCATE( champ(imdep, jmdep) )
-
-      DO  200 l = 1, lmdep
-         dimfirst(1) = 1
-         dimfirst(2) = 1
-         dimfirst(3) = l
-c
-         dimlast(1) = imdep
-         dimlast(2) = jmdep
-         dimlast(3) = 1
-c
-         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
-         print*,dimfirst,dimlast
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
-#else
-         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
-#endif
-         if (ierr.ne.0) then
-           print *, NF_STRERROR(ierr)
-           STOP
-         ENDIF 
-   
-        title = 'Rugosite Amip '
-c
-        CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
-     .                      dlon, dlat, champ, interbar          )
-
-       IF ( interbar )   THEN
-        IF( l.EQ.1 )  THEN
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour la rugosite $$$ '
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-        ENDIF
-        CALL inter_barxy(dlon, dlat(:jmdep -1), log(champ), rlonu(:iim),
-     $       rlatv, champint)
-         DO j=1,jjp1
-          DO i=1,iim
-           champint(i,j)=EXP(champint(i,j))
-          ENDDO
-         ENDDO
-
-         DO j = 1, jjp1
-           DO i = 1, iim
-             IF(NINT(mask(i,j)).NE.1)  THEN
-               champint( i,j ) = 0.001
-             ENDIF
-           ENDDO
-         ENDDO
-      ELSE
-         CALL rugosite(imdep, jmdep, dlon, dlat, champ,
-     .             iim, jjp1, rlonv, rlatu, champint, mask)
-      ENDIF
-         DO j = 1,jjp1
-         DO i = 1, iim
-            champtime (i,j,l) = champint(i,j)
-         ENDDO
-         ENDDO
-200      CONTINUE
-c
-      DO l = 1, lmdep
-         timeyear(l) = timecoord(l)
-      ENDDO
-
-      PRINT 222, timeyear(:lmdep)
-222   FORMAT(2x,' Time year ',10f6.1)
-c
-        
-      PRINT*, 'Interpolation temporelle dans l annee'
-
-      DO j = 1, jjp1
-      DO i = 1, iim
-          DO l = 1, lmdep
-            ax(l) = timeyear(l)
-            ay(l) = champtime (i,j,l)
-          ENDDO
-          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
-          DO k = 1, 360
-            time =  REAL(k-1)
-            CALL SPLINT(ax,ay,yder,lmdep,time,by)
-            champan(i,j,k) = by
-          ENDDO
-      ENDDO
-      ENDDO
-      DO k = 1, 360
-      DO j = 1, jjp1
-         champan(iip1,j,k) = champan(1,j,k)
-      ENDDO
-        IF ( k.EQ.10 )  THEN
-          DO j = 1, jjp1
-            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
-            PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
-          ENDDO
-        ENDIF
-      ENDDO
-c
-      DO k = 1, 360
-         CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
-      ENDDO
-c
-      ierr = NF_CLOSE(ncid)
-
-       DEALLOCATE( dlon      )
-       DEALLOCATE( dlon_ini  )
-       DEALLOCATE( dlat      )
-       DEALLOCATE( dlat_ini  )
-       DEALLOCATE( champ     )
-c
-c
-C Traitement de la glace oceanique
-c
-      PRINT*, 'Traitement de la glace oceanique'
-
-      ierr = NF_OPEN('amipbc_sic_1x1.nc', NF_NOWRITE, ncid)
-      if (ierr.ne.0) THEN
-        ierr = NF_OPEN('amipbc_sic_1x1_clim.nc', NF_NOWRITE, ncid)
-        if (ierr.ne.0) THEN
-          print *, NF_STRERROR(ierr)
-          STOP
-        endif
-      ENDIF
-
-cIM22/02/2002
-cIM07/03/2002 AMIP.nc & amip79to95.nc
-cIM   ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
-cIM07/03/2002 amipbc_sic_1x1_clim.nc & amipbc_sic_1x1.nc
-      ierr = NF_INQ_VARID(ncid,'sicbcs',varid)
-cIM22/02/2002
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr),'sicbcs'
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE ( dlon_ini(imdep) )
-      ALLOCATE (     dlon(imdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE ( dlat_ini(jmdep) )
-      ALLOCATE (     dlat(jmdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, lmdep
-cIM28/02/2002
-cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
-c               Ici on suppose qu'on a 12 mois (de 30 jours).
-      IF (lmdep.NE.12) THEN
-          print *, 'Unknown AMIP file: not 12 months ?'
-          STOP
-       ENDIF
-cIM28/02/2002
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-c
-      ALLOCATE ( champ(imdep, jmdep) )
-
-      DO l = 1, lmdep
-         dimfirst(1) = 1
-         dimfirst(2) = 1
-         dimfirst(3) = l
-c
-         dimlast(1) = imdep
-         dimlast(2) = jmdep
-         dimlast(3) = 1
-c
-         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
-#else
-         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
-#endif
-         if (ierr.ne.0) then
-           print *, NF_STRERROR(ierr)
-           STOP
-         ENDIF
- 
-         title = 'Sea-ice Amip '
-c
-         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
-     .                        dlon, dlat, champ, interbar          )
-c
-      IF( oldice )  THEN
-                 CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
-     .             iim, jjp1, rlonv, rlatu, champint )
-      ELSEIF ( interbar )  THEN
-       IF( l.EQ.1 )  THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour Sea-ice Amip  $$$ '
-        WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-       ENDIF
-cIM07/03/2002 
-cIM22/02/2002 : Sea-ice Amip entre 0. et 1.
-cIM    PRINT*,'SUB. limit_netcdf.F IM : Sea-ice et SST Amip_new clim' 
-cIM   DO j = 1, imdep * jmdep
-cIM28/02/2002 <==PM         champ(j) = champ(j)/100.
-cIM14/03/2002      champ(j) = max(0.0,(min(1.0, (champ(j)/100.) )))
-cIM      champ(j) = amax1(0.0,(amin1(1.0, (champ(j)/100.) )))
-cIM   ENDDO
-cIM22/02/2002
-       CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim),
-     $      rlatv, champint)
-      ELSE
-         CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
-     .             iim, jjp1, rlonv, rlatu, champint )
-      ENDIF
-         DO j = 1,jjp1
-         DO i = 1, iim
-            champtime (i,j,l) = champint(i,j)
-         ENDDO
-         ENDDO
-      ENDDO
-c
-      DO l = 1, lmdep
-cIM28/02/2002 <== PM  timeyear(l) = timecoord(l)
-cIM      timeyear(l) = timecoord(l)
-cIM07/03/2002      
-         timeyear(l) = tmidmonth(l)
-      ENDDO
-      PRINT 222,  timeyear(:lmdep)
-c
-      PRINT*, 'Interpolation temporelle'
-      DO j = 1, jjp1
-      DO i = 1, iim
-          DO l = 1, lmdep
-            ax(l) = timeyear(l)
-            ay(l) = champtime (i,j,l)
-          ENDDO
-          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
-          DO k = 1, 360
-            time =  REAL(k-1)
-            CALL SPLINT(ax,ay,yder,lmdep,time,by)
-            champan(i,j,k) = by
-          ENDDO
-      ENDDO
-      ENDDO
-      DO k = 1, 360
-      DO j = 1, jjp1
-         champan(iip1, j, k) = champan(1, j, k)
-      ENDDO
-        IF ( k.EQ.10 )  THEN
-          DO j = 1, jjp1
-            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
-            PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
-          ENDDO
-        ENDIF
-      ENDDO
-c
-cIM14/03/2002 : Sea-ice Amip entre 0. et 1.
-      PRINT*,'SUB. limit_netcdf.F IM : Sea-ice Amipbc '
-      DO k = 1, 360
-      DO j = 1, jjp1
-      DO i = 1, iim
-        champan(i, j, k) = 
-     $ amax1(0.0,(amin1(1.0,(champan(i, j, k)/100.))))
-      ENDDO
-        champan(iip1, j, k) = champan(1, j, k)
-      ENDDO
-      ENDDO
-cIM14/03/2002
-
-      DO k = 1, 360
-         CALL gr_dyn_fi(1, iip1, jjp1, klon,
-     .                  champan(1,1,k), phy_ice)
-        IF ( newlmt) THEN
-
-CPB  en attendant de mettre fraction de terre
-c
-          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
-          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
-c 
-          IF (fracterre ) THEN
-c            WRITE(*,*) 'passe dans cas fracterre' 
-            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
-            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
-            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon) 
-     $            - pctsrf_t(1:klon,is_lic,k)
-c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
-            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
-              pctsrf_t(1:klon,is_sic,k) = 0.
-            END WHERE 
-            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
-              pctsrf_t(1:klon,is_sic,k) = 0.
-              pctsrf_t(1:klon,is_oce,k) = 0.
-            END WHERE
-            DO i = 1, klon
-              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN 
-                IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
-                  pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
-                  pctsrf_t(i,is_oce,k) = 0.
-                ELSE 
-                  pctsrf_t(i,is_oce,k) = 1 - zmasq(i) 
-     $                    - pctsrf_t(i,is_sic,k)
-                  IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
-                    pctsrf_t(i,is_oce,k) = 0.
-                    pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
-                  ENDIF 
-                ENDIF
-              ENDIF  
-              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
-                WRITE(*,*) 'pb sous maille au point : i,k '
-     $              , i,k,pctsrf_t(:,is_oce,k)
-              ENDIF
-              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) + 
-     $          pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.) 
-     $            .GT. EPSFRA) THEN 
-                  WRITE(*,*) 'physiq : pb sous surface au point ', i, 
-     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
-              ENDIF 
-            END DO
-          ELSE 
-            DO i = 1, klon
-              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
-              IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
-                pctsrf_t(i,is_sic,k) = 0.
-                pctsrf_t(i,is_oce,k) = 0.                  
-                IF(phy_ice(i) .GE. 1.e-5) THEN
-                  pctsrf_t(i,is_lic,k) = phy_ice(i)
-                  pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k) 
-     .                                   - pctsrf_t(i,is_lic,k)
-                ELSE
-                  pctsrf_t(i,is_lic,k) = 0.
-                ENDIF 
-              ELSE
-                pctsrf_t(i,is_lic,k) = 0. 
-                IF(phy_ice(i) .GE. 1.e-5) THEN 
-                  pctsrf_t(i,is_ter,k) = 0.
-                  pctsrf_t(i,is_sic,k) = phy_ice(i)
-                  pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
-                ELSE
-                  pctsrf_t(i,is_sic,k) = 0.
-                  pctsrf_t(i,is_oce,k) = 1.                      
-                ENDIF 
-              ENDIF
-              verif = pctsrf_t(i,is_ter,k) +
-     .                pctsrf_t(i,is_oce,k) + 
-     .                pctsrf_t(i,is_sic,k) +
-     .                pctsrf_t(i,is_lic,k)
-              IF ( verif .LT. 1. - 1.e-5 .OR. 
-     $             verif .GT. 1 + 1.e-5) THEN  
-                WRITE(*,*) 'pb sous maille au point : i,k,verif '
-     $                    , i,k,verif
-              ENDIF 
-            END DO
-          ENDIF 
-        ELSE  
-          DO i = 1, klon
-            phy_nat(i,k) = phy_nat0(i)
-            IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
-              IF (NINT(phy_nat0(i)).EQ.0) THEN
-                phy_nat(i,k) = 3.0
-              ELSE
-                phy_nat(i,k) = 2.0
-              ENDIF
-            ENDIF
-            IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
-              IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
-            ENDIF
-          END DO
-        ENDIF
-      ENDDO
-c
-
-      ierr = NF_CLOSE(ncid)
-c
-       DEALLOCATE( dlon      )
-       DEALLOCATE( dlon_ini  )
-       DEALLOCATE( dlat      )
-       DEALLOCATE( dlat_ini  )
-       DEALLOCATE( champ     )
-
-477    continue
-c
-C Traitement de la sst
-c
-      PRINT*, 'Traitement de la sst'
-c     ierr = NF_OPEN('AMIP_SST.nc', NF_NOWRITE, ncid)
-      ierr = NF_OPEN('amipbc_sst_1x1.nc', NF_NOWRITE, ncid)
-      if (ierr.ne.0) THEN
-        ierr = NF_OPEN('amipbc_sst_1x1_clim.nc', NF_NOWRITE, ncid)
-        if (ierr.ne.0) THEN
-          print *, NF_STRERROR(ierr)
-          STOP
-        endif
-      ENDIF
-
-cIM22/02/2002
-cIM   ierr = NF_INQ_VARID(ncid,'SST',varid)
-      ierr = NF_INQ_VARID(ncid,'tosbcs',varid)
-cIM22/02/2002
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable SST ', namedim,'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
- 
-      ALLOCATE( dlon_ini(imdep) )
-      ALLOCATE(     dlon(imdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
-#endif
-
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable SST ', namedim, 'dimension ', jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE( dlat_ini(jmdep) )
-      ALLOCATE(     dlat(jmdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', lmdep
-cIM28/02/2002
-cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
-c               Ici on suppose qu'on a 12 mois (de 30 jours).
-      IF (lmdep.NE.12) THEN
-          print *, 'Unknown AMIP file: not 12 months ?'
-          STOP
-       ENDIF
-cIM28/02/2002
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-       ALLOCATE( champ(imdep, jmdep) )
-       IF( extrap )   THEN
-         ALLOCATE ( work(imdep,jmdep) )
-       ENDIF
-c
-      DO l = 1, lmdep
-         dimfirst(1) = 1
-         dimfirst(2) = 1
-         dimfirst(3) = l
-c
-         dimlast(1) = imdep
-         dimlast(2) = jmdep
-         dimlast(3) = 1
-c
-         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
-#else
-         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
-#endif
-         if (ierr.ne.0) then
-           print *, NF_STRERROR(ierr)
-           STOP
-         ENDIF
-
-         title='Sst Amip'
-c
-         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
-     .                            dlon, dlat, champ, interbar     )
-       IF ( extrap )  THEN
-        CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
-       ENDIF
-c
-
-      IF ( interbar )  THEN
-        IF( l.EQ.1 )  THEN
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour la Sst Amip $$$ '
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-        ENDIF
-        CALL inter_barxy (dlon, dlat(:jmdep -1), champ, rlonu(:iim),
-     $       rlatv, champint)
-      ELSE
-       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
-     .          iim, jjp1, rlonv, rlatu, champint   )
-      ENDIF
-
-         DO j = 1,jjp1
-         DO i = 1, iim
-            champtime (i,j,l) = champint(i,j)
-         ENDDO
-         ENDDO
-      ENDDO
-c
-      DO l = 1, lmdep
-cIM28/02/2002 <==PM  timeyear(l) = timecoord(l)
-         timeyear(l) = tmidmonth(l)
-      ENDDO
-      print 222,  timeyear(:lmdep)
-c
-C interpolation temporelle
-      DO j = 1, jjp1
-      DO i = 1, iim
-          DO l = 1, lmdep
-            ax(l) = timeyear(l)
-            ay(l) = champtime (i,j,l)
-          ENDDO
-          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
-          DO k = 1, 360
-            time =  REAL(k-1)
-            CALL SPLINT(ax,ay,yder,lmdep,time,by)
-            champan(i,j,k) = by
-          ENDDO
-      ENDDO
-      ENDDO
-      DO k = 1, 360
-      DO j = 1, jjp1
-         champan(iip1,j,k) = champan(1,j,k)
-      ENDDO
-        IF ( k.EQ.10 )  THEN
-          DO j = 1, jjp1
-            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
-            PRINT *,' SST au temps 10 ', chmin,chmax,j
-          ENDDO
-        ENDIF
-      ENDDO
-c
-cIM14/03/2002 : SST amipbc greater then 271.38
-      PRINT*,'SUB. limit_netcdf.F IM : SST Amipbc >= 271.38 '
-      DO k = 1, 360
-      DO j = 1, jjp1
-      DO i = 1, iim
-         champan(i, j, k) = amax1(champan(i, j, k), 271.38)
-      ENDDO
-         champan(iip1, j, k) = champan(1, j, k)
-      ENDDO
-      ENDDO
-cIM14/03/2002
-      DO k = 1, 360
-         CALL gr_dyn_fi(1, iip1, jjp1, klon, 
-     .                  champan(1,1,k), phy_sst(1,k))
-      ENDDO
-c
-      ierr = NF_CLOSE(ncid)
-c
-       DEALLOCATE( dlon      )
-       DEALLOCATE( dlon_ini  )
-       DEALLOCATE( dlat      )
-       DEALLOCATE( dlat_ini  )
-       DEALLOCATE( champ     )
-c
-C Traitement de l'albedo
-c
-      PRINT*, 'Traitement de l albedo'
-      ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE ( dlon_ini(imdep) )
-      ALLOCATE (     dlon(imdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-
-      ALLOCATE ( dlat_ini(jmdep) )
-      ALLOCATE (     dlat(jmdep) )
-
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', lmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
-#else
-      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
-#endif
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-c
-      ALLOCATE ( champ(imdep, jmdep) )
-
-      DO l = 1, lmdep
-         dimfirst(1) = 1
-         dimfirst(2) = 1
-         dimfirst(3) = l
-c
-         dimlast(1) = imdep
-         dimlast(2) = jmdep
-         dimlast(3) = 1
-c
-         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
-#else
-         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
-#endif
-         if (ierr.ne.0) then
-           print *, NF_STRERROR(ierr)
-           STOP
-         ENDIF
-
-         title='Albedo Amip'
-c
-         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
-     .                            dlon, dlat, champ, interbar      )
-c
-c
-      IF ( interbar )  THEN
-        IF( l.EQ.1 )  THEN
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour l Albedo Amip $$$ '
-         WRITE(6,*) '-------------------------------------------------',
-     ,'------------------------'
-        ENDIF
-
-       CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim),
-     $       rlatv, champint)
-      ELSE
-       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
-     .          iim, jjp1, rlonv, rlatu, champint   )
-      ENDIF
-c
-         DO j = 1,jjp1
-         DO i = 1, iim
-            champtime (i, j, l) = champint(i, j)
-         ENDDO
-         ENDDO
-      ENDDO
-c
-      DO l = 1, lmdep
-         timeyear(l) = timecoord(l)
-      ENDDO
-      print 222,  timeyear(:lmdep)
-c
-C interpolation temporelle
-      DO j = 1, jjp1
-      DO i = 1, iim
-          DO l = 1, lmdep
-            ax(l) = timeyear(l)
-            ay(l) = champtime (i, j, l)
-          ENDDO
-          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
-          DO k = 1, 360
-            time =  REAL(k-1)
-            CALL SPLINT(ax,ay,yder,lmdep,time,by)
-            champan(i,j,k) = by
-          ENDDO
-      ENDDO
-      ENDDO
-      DO k = 1, 360
-      DO j = 1, jjp1
-         champan(iip1, j, k) = champan(1, j, k)
-      ENDDO
-        IF ( k.EQ.10 )  THEN
-          DO j = 1, jjp1
-            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
-            PRINT *,' Albedo au temps 10 ', chmin,chmax,j
-          ENDDO
-        ENDIF
-      ENDDO
-c
-      DO k = 1, 360
-         CALL gr_dyn_fi(1, iip1, jjp1, klon,
-     .                  champan(1,1,k), phy_alb(1,k))
-      ENDDO
-c
-      ierr = NF_CLOSE(ncid)
-c
-c
-      DO k = 1, 360
-      DO i = 1, klon
-         phy_bil(i,k) = 0.0
-      ENDDO
-      ENDDO
-c
-      PRINT*, 'Ecriture du fichier limit'
-c
-      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
-     .                       "Fichier conditions aux limites")
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
-      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
-c
-      dims(1) = ndim
-      dims(2) = ntim
-c
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
-#else
-      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
-     .                        "Jour dans l annee")
-      IF (newlmt) THEN
-c
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "FOCE", NF_DOUBLE, 2,dims, id_FOCE)
-#else
-        ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
-     .                      "Fraction ocean")
-c
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "FSIC", NF_DOUBLE, 2,dims, id_FSIC)
-#else
-        ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
-     .                      "Fraction glace de mer")
-c
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "FTER", NF_DOUBLE, 2,dims, id_FTER)
-#else
-        ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
-     .                      "Fraction terre")
-c
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "FLIC", NF_DOUBLE, 2,dims, id_FLIC)
-#else
-        ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
-     .                      "Fraction land ice")
-c
-      ELSE 
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
-#else
-        ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
-     .                      "Nature du sol (0,1,2,3)")
-      ENDIF 
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
-#else
-      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
-     .                      "Temperature superficielle de la mer")
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
-#else
-      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
-     .                        "Reference flux de chaleur au sol")
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
-#else
-      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
-     .                        "Albedo a la surface")
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
-#else
-      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
-     .                        "Rugosite")
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO k = 1, 360
-c
-      debut(1) = 1
-      debut(2) = k
-      epais(1) = klon
-      epais(2) = 1
-c
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
-c
-      IF (newlmt ) THEN
-          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
-     $        ,pctsrf_t(1,is_oce,k))
-          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
-     $        ,pctsrf_t(1,is_sic,k))
-          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
-     $        ,pctsrf_t(1,is_ter,k))
-          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
-     $        ,pctsrf_t(1,is_lic,k))
-      ELSE 
-          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
-     $        ,phy_nat(1,k))
-      ENDIF 
-c
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
-#else
-      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k, REAL(k))
-      IF (newlmt ) THEN
-          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
-     $        ,pctsrf_t(1,is_oce,k))
-          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
-     $        ,pctsrf_t(1,is_sic,k))
-          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
-     $        ,pctsrf_t(1,is_ter,k))
-          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
-     $        ,pctsrf_t(1,is_lic,k))
-      ELSE 
-          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
-     $        ,phy_nat(1,k))
-      ENDIF 
-      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
-      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
-#endif
-c
-      ENDDO
-c
-      ierr = NF_CLOSE(nid)
-c
-#else
-      WRITE(lunout,*)
-     & 'limit_netcdf: Earth-specific routine, needs Earth physics'
-#endif
-! of #ifdef CPP_EARTH
-      STOP
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90	(revision 1658)
+++ LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90	(revision 1658)
@@ -0,0 +1,629 @@
+!
+! $Id: limit_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque)
+!
+!-------------------------------------------------------------------------------
+! Author : L. Fairhead, 27/01/94
+!-------------------------------------------------------------------------------
+! Purpose: Boundary conditions files building for new model using climatologies.
+!          Both grids have to be regular.
+!-------------------------------------------------------------------------------
+! Note: This routine is designed to work for Earth
+!-------------------------------------------------------------------------------
+! Modification history:
+!  * 23/03/1994: Z. X. Li
+!  *    09/1999: L. Fairhead (netcdf reading in LMDZ.3.3)
+!  *    07/2001: P. Le Van
+!  *    11/2009: L. Guez     (ozone day & night climatos, see etat0_netcdf.F90)
+!  *    12/2009: D. Cugnet   (f77->f90, calendars, files from coupled runs)
+!-------------------------------------------------------------------------------
+  USE control_mod
+#ifdef CPP_EARTH
+  USE dimphy
+  USE ioipsl,             ONLY : ioget_year_len
+  USE phys_state_var_mod, ONLY : pctsrf
+  USE netcdf,             ONLY : NF90_OPEN,    NF90_CREATE,  NF90_CLOSE,       &
+                   NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT,     &
+                   NF90_NOERR,   NF90_NOWRITE, NF90_DOUBLE,  NF90_GLOBAL,      &
+		   NF90_CLOBBER, NF90_ENDDEF,  NF90_UNLIMITED, NF90_FLOAT
+  USE inter_barxy_m, only: inter_barxy
+#endif
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+#include "dimensions.h"
+#include "paramet.h"
+#include "iniprint.h"
+  LOGICAL,                    INTENT(IN) :: interbar ! barycentric interpolation
+  LOGICAL,                    INTENT(IN) :: extrap   ! SST extrapolation flag
+  LOGICAL,                    INTENT(IN) :: oldice   ! old way ice computation
+  REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque   ! land mask
+#ifndef CPP_EARTH
+  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
+#else
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "logic.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "comconst.h"
+#include "indicesol.h"
+
+!--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) --------
+  LOGICAL, PARAMETER :: fracterre=.TRUE.
+
+!--- INPUT NETCDF FILES NAMES --------------------------------------------------
+  CHARACTER(LEN=25) :: icefile, sstfile, dumstr
+  CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc        ',        &
+                                  famipsic='amipbc_sic_1x1.nc        ',        &
+                                  fclimsst='amipbc_sst_1x1_clim.nc   ',        &
+                                  fclimsic='amipbc_sic_1x1_clim.nc   ',        &
+                                  fcpldsst='cpl_atm_sst.nc           ',        &
+                                  fcpldsic='cpl_atm_sic.nc           ',        &
+                                  frugo   ='Rugos.nc                 ',        &
+                                  falbe   ='Albedo.nc                '
+
+!--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
+  REAL,   DIMENSION(klon)                :: fi_ice, verif
+  REAL,   DIMENSION(:,:),   POINTER      :: phy_rug=>NULL(), phy_ice=>NULL()
+  REAL,   DIMENSION(:,:),   POINTER      :: phy_sst=>NULL(), phy_alb=>NULL()
+  REAL,   DIMENSION(:,:),   ALLOCATABLE  :: phy_bil
+  REAL,   DIMENSION(:,:,:), ALLOCATABLE  :: pctsrf_t
+  INTEGER                                :: nbad
+
+!--- VARIABLES FOR OUTPUT FILE WRITING -----------------------------------------
+  INTEGER :: ierr, nid, ndim, ntim, k
+  INTEGER, DIMENSION(2) :: dims
+  INTEGER :: id_tim,  id_SST,  id_BILS, id_RUG, id_ALB
+  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC
+  INTEGER :: NF90_FORMAT
+  LOGICAL :: lCPL                    !--- T: IPCC-IPSL cpl model output files
+  INTEGER :: ndays                   !--- Depending on the output calendar
+
+!--- INITIALIZATIONS -----------------------------------------------------------
+#ifdef NC_DOUBLE
+  NF90_FORMAT=NF90_DOUBLE
+#else
+  NF90_FORMAT=NF90_FLOAT
+#endif
+
+  pi    = 4.*ATAN(1.)
+  rad   = 6371229.
+  daysec= 86400.
+  omeg  = 2.*pi/daysec
+  g     = 9.8
+  kappa = 0.2857143
+  cpp   = 1004.70885
+  dtvr  = daysec/FLOAT(day_step)
+  CALL inigeom
+
+!--- Beware: anneeref (from gcm.def) is used to determine output time sampling
+  ndays=ioget_year_len(anneeref)
+
+!--- RUGOSITY TREATMENT --------------------------------------------------------
+  WRITE(lunout,*) 'Traitement de la rugosite'
+  CALL get_2Dfield(frugo,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:))
+
+!--- OCEAN TREATMENT -----------------------------------------------------------
+  PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE.
+
+! Input SIC file selection
+  icefile='fake'
+  IF(NF90_OPEN(famipsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(famipsic)
+  IF(NF90_OPEN(fclimsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fclimsic)
+  IF(NF90_OPEN(fcpldsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fcpldsic)
+  SELECT CASE(icefile)
+    CASE(famipsic); dumstr='Amip.'
+    CASE(fclimsic); dumstr='Amip climatologique.'
+    CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE.
+    CASE('fake');   CALL abort_gcm('limit_netcdf','Fichier SIC non reconnu.',1)
+  END SELECT
+  ierr=NF90_CLOSE(nid)
+  WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr)
+
+  CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL)
+
+  ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
+  DO k=1,ndays
+    fi_ice=phy_ice(:,k)
+    WHERE(fi_ice>=1.0  ) fi_ice=1.0
+    WHERE(fi_ice<EPSFRA) fi_ice=0.0
+    IF(fracterre) THEN
+      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
+      pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
+      IF(lCPL) THEN                               ! SIC=pICE*(1-LIC-TER)
+        pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter))
+      ELSE                                        ! SIC=pICE-LIC
+        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
+      END IF
+      WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
+      WHERE(1.0-zmasq<EPSFRA)
+        pctsrf_t(:,is_sic,k)=0.0
+        pctsrf_t(:,is_oce,k)=0.0
+      ELSEWHERE
+        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
+          pctsrf_t(:,is_sic,k)=1.0-zmasq
+          pctsrf_t(:,is_oce,k)=0.0
+        ELSEWHERE
+          pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
+          WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
+            pctsrf_t(:,is_oce,k)=0.0
+            pctsrf_t(:,is_sic,k)=1.0-zmasq
+          END WHERE
+        END WHERE
+      END WHERE
+      nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
+      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
+      nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
+      IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
+    ELSE 
+      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)
+      WHERE(NINT(pctsrf(:,is_ter))==1)
+        pctsrf_t(:,is_sic,k)=0.
+        pctsrf_t(:,is_oce,k)=0.                  
+        WHERE(fi_ice>=1.e-5)
+          pctsrf_t(:,is_lic,k)=fi_ice
+          pctsrf_t(:,is_ter,k)=pctsrf_t(:,is_ter,k)-pctsrf_t(:,is_lic,k)
+        ELSEWHERE
+          pctsrf_t(:,is_lic,k)=0.0
+        END WHERE
+      ELSEWHERE
+        pctsrf_t(:,is_lic,k) = 0.0 
+        WHERE(fi_ice>=1.e-5)
+          pctsrf_t(:,is_ter,k)=0.0
+          pctsrf_t(:,is_sic,k)=fi_ice
+          pctsrf_t(:,is_oce,k)=1.0-pctsrf_t(:,is_sic,k)
+        ELSEWHERE
+          pctsrf_t(:,is_sic,k)=0.0
+          pctsrf_t(:,is_oce,k)=1.0
+        END WHERE
+      END WHERE
+      verif=sum(pctsrf_t(:,:,k),dim=2)
+      nbad=COUNT(verif<1.0-1.e-5.OR.verif>1.0+1.e-5)
+      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
+    END IF 
+  END DO
+  DEALLOCATE(phy_ice)
+
+!--- SST TREATMENT -------------------------------------------------------------
+  WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE.
+
+! Input SST file selection
+  sstfile='fake'
+  IF(NF90_OPEN(famipsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(famipsst)
+  IF(NF90_OPEN(fclimsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fclimsst)
+  IF(NF90_OPEN(fcpldsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fcpldsst)
+  SELECT CASE(icefile)
+    CASE(famipsic); dumstr='Amip.'
+    CASE(fclimsic); dumstr='Amip climatologique.'
+    CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE.
+    CASE('fake');   CALL abort_gcm('limit_netcdf','Fichier SST non reconnu',1)
+  END SELECT
+  ierr=NF90_CLOSE(nid)
+  WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(dumstr)
+
+  CALL get_2Dfield(trim(sstfile),'SST',interbar,ndays,phy_sst,flag=extrap)
+
+!--- ALBEDO TREATMENT ----------------------------------------------------------
+  WRITE(lunout,*) 'Traitement de l albedo'
+  CALL get_2Dfield(falbe,'ALB',interbar,ndays,phy_alb)
+
+!--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
+  ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
+
+!--- OUTPUT FILE WRITING -------------------------------------------------------
+  WRITE(lunout,*) 'Ecriture du fichier limit'
+
+  !--- File creation
+  ierr=NF90_CREATE("limit.nc",NF90_CLOBBER,nid)
+  ierr=NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier conditions aux limites")
+
+  !--- Dimensions creation
+  ierr=NF90_DEF_DIM(nid,"points_physiques",klon,ndim)
+  ierr=NF90_DEF_DIM(nid,"time",NF90_UNLIMITED,ntim)
+
+  dims=(/ndim,ntim/)
+
+  !--- Variables creation
+  ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,(/ntim/),id_tim)
+  ierr=NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE)
+  ierr=NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC)
+  ierr=NF90_DEF_VAR(nid,"FTER", NF90_FORMAT,dims,id_FTER)
+  ierr=NF90_DEF_VAR(nid,"FLIC", NF90_FORMAT,dims,id_FLIC)
+  ierr=NF90_DEF_VAR(nid,"SST",  NF90_FORMAT,dims,id_SST)
+  ierr=NF90_DEF_VAR(nid,"BILS", NF90_FORMAT,dims,id_BILS)
+  ierr=NF90_DEF_VAR(nid,"ALB",  NF90_FORMAT,dims,id_ALB)
+  ierr=NF90_DEF_VAR(nid,"RUG",  NF90_FORMAT,dims,id_RUG)
+
+  !--- Attributes creation
+  ierr=NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee")
+  ierr=NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean")
+  ierr=NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer")
+  ierr=NF90_PUT_ATT(nid,id_FTER,"title","Fraction terre")
+  ierr=NF90_PUT_ATT(nid,id_FLIC,"title","Fraction land ice")
+  ierr=NF90_PUT_ATT(nid,id_SST ,"title","Temperature superficielle de la mer")
+  ierr=NF90_PUT_ATT(nid,id_BILS,"title","Reference flux de chaleur au sol")
+  ierr=NF90_PUT_ATT(nid,id_ALB, "title","Albedo a la surface")
+  ierr=NF90_PUT_ATT(nid,id_RUG, "title","Rugosite")
+
+  ierr=NF90_ENDDEF(nid)
+
+  !--- Variables saving
+  ierr=NF90_PUT_VAR(nid,id_tim,(/(REAL(k),k=1,ndays)/))
+  ierr=NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FTER,pctsrf_t(:,is_ter,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FLIC,pctsrf_t(:,is_lic,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_SST ,phy_sst(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_BILS,phy_bil(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_ALB ,phy_alb(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_RUG ,phy_rug(:,:),(/1,1/),(/klon,ndays/))
+
+  ierr=NF90_CLOSE(nid)
+
+  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
+#endif
+! of #ifdef CPP_EARTH
+
+
+!===============================================================================
+!
+  CONTAINS
+!
+!===============================================================================
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)
+!
+!-----------------------------------------------------------------------------
+! Comments:
+!   There are two assumptions concerning the NetCDF files, that are satisfied
+!   with files that are conforming NC convention:
+!     1) The last dimension of the variables used is the time record.
+!     2) Dimensional variables have the same names as corresponding dimensions.
+!-----------------------------------------------------------------------------
+  USE netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, &
+       NF90_CLOSE, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_GET_VAR, &
+       NF90_GET_ATT
+  USE dimphy, ONLY : klon
+  USE phys_state_var_mod, ONLY : pctsrf
+  USE control_mod
+  use pchsp_95_m, only: pchsp_95
+  use pchfe_95_m, only: pchfe_95
+  use arth_m, only: arth
+
+  IMPLICIT NONE
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "indicesol.h"
+#include "iniprint.h"
+!-----------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
+  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
+  LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
+  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
+  REAL,    POINTER,  DIMENSION(:, :) :: champo   ! output field = f(t)
+  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
+  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
+  LOGICAL, OPTIONAL, INTENT(IN)     :: lCPL     ! Coupled model flag (for ICE)
+!------------------------------------------------------------------------------
+! Local variables:
+!--- NetCDF
+  INTEGER :: ncid, varid                  ! NetCDF identifiers
+  CHARACTER(LEN=30)               :: dnam       ! dimension name
+  CHARACTER(LEN=80)               :: varname    ! NetCDF variable name
+!--- dimensions
+  INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
+  REAL, ALLOCATABLE, DIMENSION(:) :: dlon_ini   ! initial longitudes vector
+  REAL, ALLOCATABLE, DIMENSION(:) :: dlat_ini   ! initial latitudes  vector
+  REAL, POINTER,     DIMENSION(:) :: dlon, dlat ! reordered lon/lat  vectors
+!--- fields
+  INTEGER :: imdep, jmdep, lmdep                ! dimensions of 'champ'
+  REAL, ALLOCATABLE, DIMENSION(:, :) :: champ   ! wanted field on initial grid
+  REAL, ALLOCATABLE, DIMENSION(:) :: yder, timeyear
+  REAL,              DIMENSION(iim, jjp1) :: champint   ! interpolated field
+  REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: champtime
+  REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: champan
+!--- input files
+  CHARACTER(LEN=20)                 :: cal_in   ! calendar
+  INTEGER                           :: ndays_in ! number of days
+!--- misc
+  INTEGER :: i, j, k, l                         ! loop counters
+  REAL, ALLOCATABLE, DIMENSION(:, :) :: work     ! used for extrapolation
+  CHARACTER(LEN=25)                 :: title    ! for messages
+  LOGICAL                           :: extrp    ! flag for extrapolation
+  REAL                              :: chmin, chmax
+  INTEGER ierr
+  integer n_extrap ! number of extrapolated points
+  logical skip
+!------------------------------------------------------------------------------
+!---Variables depending on keyword 'mode' -------------------------------------
+  NULLIFY(champo)
+  SELECT CASE(mode)
+    CASE('RUG'); varname='RUGOS';  title='Rugosite'
+    CASE('SIC'); varname='sicbcs'; title='Sea-ice'
+    CASE('SST'); varname='tosbcs'; title='SST'
+    CASE('ALB'); varname='ALBEDO'; title='Albedo'
+  END SELECT
+  extrp=.FALSE. 
+  IF ( PRESENT(flag) ) THEN 
+    IF ( flag .AND. mode=='SST' ) extrp=.TRUE. 
+  END IF
+
+!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
+  ierr=NF90_OPEN(fnam, NF90_NOWRITE, ncid);             CALL ncerr(ierr, fnam)
+  ierr=NF90_INQ_VARID(ncid, varname, varid);            CALL ncerr(ierr, fnam)
+  ierr=NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids); CALL ncerr(ierr, fnam)
+
+!--- Longitude
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(1), name=dnam, len=imdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(dlon_ini(imdep), dlon(imdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
+  WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
+
+!--- Latitude
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(2), name=dnam, len=jmdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(dlat_ini(jmdep), dlat(jmdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
+  WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
+
+!--- Time (variable is not needed - it is rebuilt - but calendar is)
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(3), name=dnam, len=lmdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(timeyear(lmdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  cal_in=' '
+  ierr=NF90_GET_ATT(ncid, varid, 'calendar', cal_in)
+  IF(ierr/=NF90_NOERR) THEN
+    SELECT CASE(mode)
+      CASE('RUG', 'ALB'); cal_in='360d'
+      CASE('SIC', 'SST'); cal_in='gregorian'
+    END SELECT
+    WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
+         // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
+  END IF
+  WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
+       cal_in
+
+!--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
+  !--- Determining input file number of days, depending on calendar
+  ndays_in=year_len(anneeref, cal_in)
+
+!--- Time vector reconstruction (time vector from file is not trusted)
+!--- If input records are not monthly, time sampling has to be constant !
+  timeyear=mid_months(anneeref, cal_in, lmdep)
+  IF (lmdep /= 12) WRITE(lunout, '(a, i3, a)') 'Note : les fichiers de ' &
+       // TRIM(mode) // ' ne comportent pas 12, mais ', lmdep, &
+       ' enregistrements.'
+
+!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
+  ALLOCATE(champ(imdep, jmdep), champtime(iim, jjp1, lmdep))
+  IF(extrp) ALLOCATE(work(imdep, jmdep))
+
+  WRITE(lunout, *)
+  WRITE(lunout, '(a, i3, a)')'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, &
+       ' CHAMPS.'
+  ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
+  DO l=1, lmdep
+    ierr=NF90_GET_VAR(ncid, varid, champ, (/1, 1, l/), (/imdep, jmdep, 1/))
+    CALL ncerr(ierr, fnam)
+    CALL conf_dat2d(title, imdep, jmdep, dlon_ini, dlat_ini, dlon, dlat, &
+         champ, ibar)
+
+    IF (extrp) CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, &
+         work)
+
+    IF(ibar.AND..NOT.(mode=='SIC'.AND.flag)) THEN
+      IF(l==1) THEN
+        WRITE(lunout, *)                                                      &
+  '-------------------------------------------------------------------------'
+        WRITE(lunout, *)                                                     &
+  'Utilisation de l''interpolation barycentrique pour '//TRIM(title)//' $$$'
+        WRITE(lunout, *)                                                      &
+  '-------------------------------------------------------------------------'
+      END IF
+      IF(mode=='RUG') champ=LOG(champ)
+      CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim),     &
+                         rlatv, champint)
+      IF(mode=='RUG') THEN
+        champint=EXP(champint)
+        WHERE(NINT(mask)/=1) champint=0.001
+      END IF
+    ELSE
+      SELECT CASE(mode)
+        CASE('RUG');       CALL rugosite(imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint, mask)
+        CASE('SIC');       CALL sea_ice (imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint)
+        CASE('SST', 'ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint)
+      END SELECT
+    END IF
+    champtime(:, :, l)=champint
+  END DO
+  ierr=NF90_CLOSE(ncid);                                 CALL ncerr(ierr, fnam)
+
+  DEALLOCATE(dlon_ini, dlat_ini, dlon, dlat, champ)
+  IF(extrp) DEALLOCATE(work)
+
+!--- TIME INTERPOLATION ------------------------------------------------------
+  WRITE(lunout, *)
+  WRITE(lunout, *)'INTERPOLATION TEMPORELLE.'
+  WRITE(lunout, "(2x, ' Vecteur temps en entree: ', 10f6.1)") timeyear
+  WRITE(lunout, "(2x, ' Vecteur temps en sortie de 0 a ', i3)") ndays
+  ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
+  skip = .false.
+  n_extrap = 0
+  DO j=1, jjp1
+    DO i=1, iim
+      yder = pchsp_95(timeyear, champtime(i, j, :), ibeg=2, iend=2, &
+           vc_beg=0., vc_end=0.)
+      CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, &
+           arth(0., real(ndays_in) / ndays, ndays), champan(i, j, :), ierr)
+      if (ierr < 0) stop 1
+      n_extrap = n_extrap + ierr
+    END DO
+  END DO
+  if (n_extrap /= 0) then
+     print *, "get_2Dfield pchfe_95: n_extrap = ", n_extrap
+  end if
+  champan(iip1, :, :)=champan(1, :, :)
+  DEALLOCATE(yder, champtime, timeyear)
+
+!--- Checking the result
+  DO j=1, jjp1
+    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
+    WRITE(lunout, *)' '//TRIM(title)//' au temps 10 ', chmin, chmax, j
+  END DO
+
+!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
+  IF(mode=='SST') THEN
+    WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
+    WHERE(champan<271.38) champan=271.38
+  END IF
+
+!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
+  IF(mode=='SIC') THEN
+    WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0'
+    IF(.NOT.lCPL) champan(:, :, :)=champan(:, :, :)/100.
+    champan(iip1, :, :)=champan(1, :, :)
+    WHERE(champan>1.0) champan=1.0
+    WHERE(champan<0.0) champan=0.0
+  END IF
+
+!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
+  ALLOCATE(champo(klon, ndays))
+  DO k=1, ndays
+    CALL gr_dyn_fi(1, iip1, jjp1, klon, champan(1, 1, k), champo(1, k))
+  END DO
+  DEALLOCATE(champan)
+
+END SUBROUTINE get_2Dfield
+!
+!-------------------------------------------------------------------------------
+
+
+
+!-------------------------------------------------------------------------------
+!
+FUNCTION year_len(y,cal_in)
+!
+!-------------------------------------------------------------------------------
+  USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER                       :: year_len
+  INTEGER,           INTENT(IN) :: y
+  CHARACTER(LEN=*),  INTENT(IN) :: cal_in
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=20)             :: cal_out              ! calendar (for outputs)
+!-------------------------------------------------------------------------------
+!--- Getting the input calendar to reset at the end of the function
+  CALL ioget_calendar(cal_out)
+
+!--- Unlocking calendar and setting it to wanted one
+  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+
+!--- Getting the number of days in this year
+  year_len=ioget_year_len(y)
+
+!--- Back to original calendar
+  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+
+END FUNCTION year_len
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+FUNCTION mid_months(y,cal_in,nm)
+!
+!-------------------------------------------------------------------------------
+  USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,                INTENT(IN) :: y               ! year
+  CHARACTER(LEN=*),       INTENT(IN) :: cal_in          ! calendar
+  INTEGER,                INTENT(IN) :: nm              ! months/year number
+  REAL,    DIMENSION(nm)             :: mid_months      ! mid-month times
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=99)                  :: mess            ! error message
+  CHARACTER(LEN=20)                  :: cal_out         ! calendar (for outputs)
+  INTEGER, DIMENSION(nm)             :: mnth            ! months lengths (days)
+  INTEGER                            :: m               ! months counter
+  INTEGER                            :: nd              ! number of days
+!-------------------------------------------------------------------------------
+  nd=year_len(y,cal_in)
+
+  IF(nm==12) THEN
+
+  !--- Getting the input calendar to reset at the end of the function
+    CALL ioget_calendar(cal_out)
+
+  !--- Unlocking calendar and setting it to wanted one
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+
+  !--- Getting the length of each month
+    DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO
+
+  !--- Back to original calendar
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+
+  ELSE IF(MODULO(nd,nm)/=0) THEN
+    WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&
+      nm,' months/year. Months number should divide days number.'
+    CALL abort_gcm('mid_months',TRIM(mess),1)
+
+  ELSE
+    mnth=(/(m,m=1,nm,nd/nm)/)
+  END IF
+
+!--- Mid-months times
+  mid_months(1)=0.5*FLOAT(mnth(1))
+  DO k=2,nm
+    mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k))
+  END DO
+
+END FUNCTION mid_months
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE ncerr(ncres,fnam)
+!
+!-------------------------------------------------------------------------------
+! Purpose: NetCDF errors handling.
+!-------------------------------------------------------------------------------
+  USE netcdf, ONLY : NF90_NOERR, NF90_STRERROR
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncres
+  CHARACTER(LEN=*), INTENT(IN) :: fnam
+!-------------------------------------------------------------------------------
+#include "iniprint.h"
+  IF(ncres/=NF90_NOERR) THEN
+    WRITE(lunout,*)'Problem with file '//TRIM(fnam)//' in routine limit_netcdf.'
+    CALL abort_gcm('limit_netcdf',NF90_STRERROR(ncres),1)
+  END IF
+
+END SUBROUTINE ncerr
+!
+!-------------------------------------------------------------------------------
+
+
+END SUBROUTINE limit_netcdf
Index: LMDZ5/trunk/libf/dyn3dmem/logic.h
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/logic.h	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/logic.h	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id: logic.h 1319 2010-02-23 21:29:54Z fairhead $
 !
 !
@@ -9,9 +9,11 @@
       COMMON/logic/ purmats,iflag_phys,forward,leapf,apphys,            &
      &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
-     &  ,read_start,ok_guide,ok_strato,ok_gradsfile
+     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
+     &  ,ok_limit,ok_etat0
 
       LOGICAL purmats,forward,leapf,apphys,statcl,conser,               &
      & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
-     &  ,read_start,ok_guide,ok_strato,ok_gradsfile
+     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
+     &  ,ok_limit,ok_etat0
 
       INTEGER iflag_phys
Index: LMDZ5/trunk/libf/dyn3dmem/nxgrad_gam_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/nxgrad_gam_p.F	(revision 1657)
+++ 	(revision )
@@ -1,67 +1,0 @@
-      SUBROUTINE nxgrad_gam_p( klevel, rot, x, y )
-c
-c  P. Le Van
-c
-c   ********************************************************************
-c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
-c   ********************************************************************
-c       rot          est un argument  d'entree pour le s-prog
-c       x  et y    sont des arguments de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-      INTEGER klevel
-      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
-      INTEGER   l,ij
-      integer ismin,ismax
-      external ismin,ismax
-      INTEGER :: ijb,ije
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO 10 l = 1,klevel
-c
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-      
-      DO 1  ij = ijb+1, ije
-      y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
-   1  CONTINUE
-c
-c    ..... correction pour  y ( 1,j,l )  ......
-c
-c    ....    y(1,j,l)= y(iip1,j,l) ....
-CDIR$ IVDEP
-      DO 2  ij = ijb, ije, iip1
-      y( ij,l ) = y( ij +iim,l )
-   2  CONTINUE
-c
-      ijb=ij_begin
-      ije=ij_end+iip1
-      if(pole_nord) ijb=ij_begin+iip1
-      if(pole_sud) ije=ij_end-iip1
-      
-      DO 4  ij = ijb,ije
-      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
-   4  CONTINUE
-    
-      if (pole_nord) then
-        DO  ij = 1,iip1
-         x(    ij    ,l ) = 0.
-        ENDDO
-      endif
-
-      if (pole_sud) then
-        DO  ij = 1,iip1
-         x( ij +ip1jm,l ) = 0.
-        ENDDO
-      endif
-c
-  10  CONTINUE
-c$OMP END DO NOWAIT
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/nxgrad_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/nxgrad_p.F	(revision 1657)
+++ 	(revision )
@@ -1,67 +1,0 @@
-      SUBROUTINE nxgrad_p (klevel, rot, x, y )
-c
-c     P. Le Van
-c
-c   ********************************************************************
-c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
-c   ********************************************************************
-c       rot          est un argument  d'entree pour le s-prog
-c       x  et y    sont des arguments de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-      INTEGER klevel
-      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
-      INTEGER   l,ij
-      INTEGER :: ijb,ije
-c
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO 10 l = 1,klevel
-c
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_sud)  ije=ij_end-iip1
-       
-      DO 1  ij = ijb+1, ije
-      y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
-   1  CONTINUE
-c
-c    ..... correction pour  y ( 1,j,l )  ......
-c
-c    ....    y(1,j,l)= y(iip1,j,l) ....
-CDIR$ IVDEP
-      DO 2  ij = ijb, ije, iip1
-      y( ij,l ) = y( ij +iim,l )
-   2  CONTINUE
-c
-      ijb=ij_begin
-      ije=ij_end+iip1
-      
-      if (pole_nord)  ijb=ij_begin+iip1
-      if (pole_sud)  ije=ij_end-iip1
-      
-      DO 4  ij = ijb,ije
-      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
-   4  CONTINUE
-   
-      if (pole_nord) then 
-        DO ij = 1,iip1
-          x(    ij    ,l ) = 0.
-        ENDDO
-      endif
-      
-      if (pole_sud) then 
-        DO ij = 1,iip1
-          x( ij +ip1jm,l ) = 0.
-        ENDDO
-      endif
-c
-  10  CONTINUE
-c$OMP END DO NOWAIT
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/nxgraro2_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/nxgraro2_p.F	(revision 1657)
+++ 	(revision )
@@ -1,141 +1,0 @@
-       SUBROUTINE nxgraro2_p (klevel,xcov, ycov, lr, grx_out, gry_out )
-c
-c      P.Le Van .
-c   ***********************************************************
-c                                 lr
-c      calcul de  ( nxgrad (rot) )   du vect. v  ....
-c
-c       xcov et ycov  etant les compos. covariantes de  v
-c   ***********************************************************
-c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
-c      grx   et  gry     sont des arguments de sortie pour le s-prog
-c
-c
-      USE write_Field_p
-      USE parallel
-      USE times
-      USE mod_hallo
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
-c
-c    ......  variables en arguments  .......
-c
-      INTEGER klevel
-      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
-      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
-      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
-c
-c    ......   variables locales     ........
-c
-      REAL,SAVE :: rot(ip1jm,llm)
-      REAL  signe, nugradrs
-      INTEGER l,ij,iter,lr
-      Type(Request) :: Request_dissip
-c    ........................................................
-c
-      INTEGER :: ijb,ije,jjb,jje
-      
-c
-c
-      signe    = (-1.)**lr
-      nugradrs = signe * crot
-c
-c      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
-c      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
- 
-      ijb=ij_begin
-      ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO    l = 1, klevel
-        grx(ijb:ije,l)=xcov(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-c$OMP BARRIER
-       call Register_Hallo(grx,ip1jmp1,llm,0,1,1,0,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO    l = 1, klevel
-        gry(ijb:ije,l)=ycov(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
- 
-c
-      CALL     rotatf_p     ( klevel, grx, gry, rot )
-c      call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
-
-c$OMP BARRIER
-       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-      
-      CALL laplacien_rot_p ( klevel, rot, rot,grx,gry      )
-c       call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
-c
-c    .....   Iteration de l'operateur laplacien_rotgam  .....
-c
-      DO  iter = 1, lr -2
-c$OMP BARRIER
-       call Register_Hallo(rot,ip1jm,llm,1,1,1,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-
-	CALL laplacien_rotgam_p ( klevel, rot, rot )
-      ENDDO
-      
-c       call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
-      
-c
-c
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-       
-      CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2,1, .FALSE.,1)
-c$OMP BARRIER
-       call Register_Hallo(rot,ip1jm,llm,1,0,0,1,Request_dissip)
-       call SendRequest(Request_dissip)
-c$OMP BARRIER
-       call WaitRequest(Request_dissip)
-c$OMP BARRIER
-
-      CALL nxgrad_p ( klevel, rot, grx, gry )
-
-c
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)    
-      DO    l = 1, klevel
-        
-         if(pole_sud) ije=ij_end-iip1
-         DO  ij = ijb, ije
-          gry_out( ij,l ) = gry( ij,l ) * nugradrs
-         ENDDO
-        
-         if(pole_sud) ije=ij_end
-         DO  ij = ijb, ije
-          grx_out( ij,l ) = grx( ij,l ) * nugradrs
-         ENDDO
-     
-      ENDDO
-c$OMP END DO NOWAIT
-c
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/ppm3d.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/ppm3d.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/ppm3d.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: ppm3d.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: ppm3d.F 1403 2010-07-01 09:02:53Z fairhead $
 !
 
Index: LMDZ5/trunk/libf/dyn3dmem/pres2lev.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/pres2lev.F90	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/pres2lev.F90	(revision 1658)
@@ -60,5 +60,5 @@
       DO k=1,ni*nj
         IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = varo(k,1)
+          varn(k,ln) = zvaro(k,1)
         ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
           varn(k,ln) = zvaro(k,lmo)
Index: LMDZ5/trunk/libf/dyn3dmem/pression_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/pression_p.F	(revision 1657)
+++ 	(revision )
@@ -1,40 +1,0 @@
-      SUBROUTINE pression_p( ngrid, ap, bp, ps, p )
-      USE parallel
-c
-
-c      Auteurs : P. Le Van , Fr.Hourdin  .
-
-c  ************************************************************************
-c     Calcule la pression p(l) aux differents niveaux l = 1 ( niveau du
-c     sol) a l = llm +1 ,ces niveaux correspondant aux interfaces des (llm) 
-c     couches , avec  p(ij,llm +1) = 0.  et p(ij,1) = ps(ij)  .      
-c  ************************************************************************
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-c
-      INTEGER ngrid
-      INTEGER l,ij
- 
-      REAL ap( llmp1 ), bp( llmp1 ), ps( ngrid ), p( ngrid,llmp1 ) 
-      
-      INTEGER ijb,ije
-
-      
-      ijb=ij_begin-iip1
-      ije=ij_end+2*iip1
-      
-      if (pole_nord) ijb=ij_begin
-      if (pole_sud)  ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
-      DO    l    = 1, llmp1
-        DO  ij   = ijb, ije
-         p(ij,l) = ap(l) + bp(l) * ps(ij)
-        ENDDO
-      ENDDO
-c$OMP END DO NOWAIT   
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/qminimum_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/qminimum_p.F	(revision 1657)
+++ 	(revision )
@@ -1,107 +1,0 @@
-      SUBROUTINE qminimum_p( q,nq,deltap )
-      USE parallel
-      IMPLICIT none
-c
-c  -- Objet : Traiter les valeurs trop petites (meme negatives)
-c             pour l'eau vapeur et l'eau liquide
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-c
-      INTEGER nq
-      REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
-c
-      INTEGER iq_vap, iq_liq
-      PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
-      PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
-      REAL seuil_vap, seuil_liq
-      PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
-      PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
-c
-c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
-c            parametres seuil_vap, seuil_liq soient pareilles a celles 
-c            qui  sont utilisees dans la routine    ADDFI       )
-c     .................................................................
-c
-      INTEGER i, k, iq
-      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
-c
-      REAL SSUM
-      EXTERNAL SSUM
-c
-      INTEGER imprim
-      SAVE imprim
-      DATA imprim /0/
-c$OMP THREADPRIVATE(imprim)
-      INTEGER ijb,ije
-      INTEGER Index_pump(ip1jmp1)
-      INTEGER nb_pump
-c
-c Quand l'eau liquide est trop petite (ou negative), on prend
-c l'eau vapeur de la meme couche et la convertit en eau liquide
-c (sans changer la temperature !)
-c
-
-      ijb=ij_begin
-      ije=ij_end
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
-      DO 1000 k = 1, llm
-      DO 1040 i = ijb, ije
-            if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
-               q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
-               q(i,k,iq_liq) = seuil_liq
-            endif
- 1040 CONTINUE
- 1000 CONTINUE
-c$OMP END DO NOWAIT
-c$OMP BARRIER
-c --->  SYNCHRO OPENMP ICI
-
-c
-c Quand l'eau vapeur est trop faible (ou negative), on complete
-c le defaut en prennant de l'eau vapeur de la couche au-dessous.
-c
-      iq = iq_vap
-c
-      DO k = llm, 2, -1
-ccc      zx_abc = dpres(k) / dpres(k-1)
-c$OMP DO SCHEDULE(STATIC)
-      DO i = ijb, ije
-         if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
-            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
-     &           deltap(i,k) / deltap(i,k-1)
-            q(i,k,iq)   =  seuil_vap  
-         endif
-      ENDDO
-c$OMP END DO NOWAIT
-      ENDDO
-c$OMP BARRIER
-c
-c Quand il s'agit de la premiere couche au-dessus du sol, on
-c doit imprimer un message d'avertissement (saturation possible).
-c
-      nb_pump=0
-c$OMP DO SCHEDULE(STATIC)
-      DO i = ijb, ije
-         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
-         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
-         IF (zx_pump(i) > 0.0) THEN
-            nb_pump = nb_pump+1
-            Index_pump(nb_pump)=i
-         ENDIF
-      ENDDO
-c$OMP END DO  
-!      pompe = SSUM(ije-ijb+1,zx_pump(ijb),1)
-
-      IF (imprim.LE.100 .AND. nb_pump .GT. 0 ) THEN
-         PRINT *, 'ATT!:on pompe de l eau au sol'
-         DO i = 1, nb_pump
-               imprim = imprim + 1
-               PRINT*,'  en ',index_pump(i),zx_pump(index_pump(i))
-         ENDDO
-      ENDIF
-c
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/ran1.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/ran1.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/ran1.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: ran1.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: ran1.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       FUNCTION RAN1(IDUM)
Index: LMDZ5/trunk/libf/dyn3dmem/rotat_nfil_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/rotat_nfil_p.F	(revision 1657)
+++ 	(revision )
@@ -1,52 +1,0 @@
-      SUBROUTINE rotat_nfil_p (klevel, x, y, rot )
-c
-c    Auteur :   P.Le Van 
-c**************************************************************
-c.          Calcule le rotationnel  non filtre   ,
-c      a tous les niveaux d'1 vecteur de comp. x et y ..
-c       x  et  y etant des composantes  covariantes  ...
-c********************************************************************
-c   klevel, x  et y   sont des arguments d'entree pour le s-prog
-c        rot          est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-c
-c   .....  variables en arguments  ......
-c
-      INTEGER klevel
-      REAL rot( ip1jm,klevel )
-      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
-c
-c  ...   variables  locales  ...
-c
-      INTEGER  l, ij
-      INTEGER :: ijb,ije
-c
-c
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
-      DO  10 l = 1,klevel
-c
-        DO   ij = ijb, ije - 1
-         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
-     *                   x(ij +iip1, l )  -  x( ij,l )  
-        ENDDO
-c
-c    .... correction pour rot( iip1,j,l)  ....
-c    ....   rot(iip1,j,l)= rot(1,j,l) ...
-CDIR$ IVDEP
-        DO  ij = ijb+iip1-1, ije, iip1
-         rot( ij,l ) = rot( ij -iim,l )
-        ENDDO
-c
-  10  CONTINUE
-c$OMP END DO NOWAIT
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/rotatf_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/rotatf_p.F	(revision 1657)
+++ 	(revision )
@@ -1,67 +1,0 @@
-      SUBROUTINE rotatf_p (klevel, x, y, rot )
-c
-c     Auteur : P.Le Van 
-c**************************************************************
-c.  calcule le rotationnel
-c     a tous les niveaux d'1 vecteur de comp. x et y ..
-c       x  et  y etant des composantes  covariantes  ...
-c********************************************************************
-c   klevel, x  et y   sont des arguments d'entree pour le s-prog
-c        rot          est  un argument  de sortie pour le s-prog
-c
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-c
-c   .....  variables en arguments  ......
-c
-      INTEGER klevel
-      REAL rot( ip1jm,klevel )
-      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
-c
-c  ...   variables  locales  ...
-c
-      INTEGER  l, ij
-      INTEGER :: ijb,ije,jjb,jje
-c
-c
-      ijb=ij_begin
-      ije=ij_end
-      if(pole_sud) ije=ij_end-iip1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      DO  10 l = 1,klevel
-c
-        DO   ij = ijb, ije - 1
-         rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
-     *                   x(ij +iip1, l )  -  x( ij,l )  
-        ENDDO
-c
-c    .... correction pour rot( iip1,j,l)  ....
-c    ....   rot(iip1,j,l)= rot(1,j,l) ...
-CDIR$ IVDEP
-        DO  ij = ijb+iip1-1, ije, iip1
-         rot( ij,l ) = rot( ij -iim,l )
-        ENDDO
-c
-  10  CONTINUE
-c$OMP END DO NOWAIT
-        jjb=jj_begin
-        jje=jj_end
-        if (pole_sud) jje=jj_end-1
-        CALL filtreg_p( rot, jjb,jje,jjm, klevel, 2, 2, .FALSE., 1 )
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
-        DO l = 1, klevel
-          DO ij = ijb, ije
-           rot(ij,l) = rot(ij,l) * unsairez(ij)
-          ENDDO
-        ENDDO
-c$OMP END DO NOWAIT
-c
-c
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/sortvarc.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/sortvarc.F	(revision 1658)
+++ LMDZ5/trunk/libf/dyn3dmem/sortvarc.F	(revision 1658)
@@ -0,0 +1,166 @@
+!
+! $Id: sortvarc.F 1403 2010-07-01 09:02:53Z fairhead $
+!
+      SUBROUTINE sortvarc
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:    P. Le Van
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   sortie des variables de controle
+c
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "temps.h"
+
+c   Arguments:
+c   ----------
+
+      INTEGER itau
+      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL vorpot(ip1jm,llm)
+      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
+      REAL dp(ip1jmp1)
+      REAL time
+      REAL pk(ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
+      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
+      REAL cosphi(ip1jm),omegcosp(ip1jm)
+      REAL dtvrs1j,rjour,heure,radsg,radomeg
+      REAL rday, massebxy(ip1jm,llm)
+      INTEGER  l, ij, imjmp1
+
+      REAL       SSUM
+
+c-----------------------------------------------------------------------
+
+       dtvrs1j   = dtvr/daysec
+       rjour     = REAL( INT( itau * dtvrs1j ))
+       heure     = ( itau*dtvrs1j-rjour ) * 24.
+       imjmp1    = iim * jjp1
+       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
+c
+       CALL massbarxy ( masse, massebxy )
+
+c   .....  Calcul  de  rmsdpdt  .....
+
+       ge(:)=dp(:)*dp(:)
+
+       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+c
+       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1) 
+
+       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
+       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
+
+c   .....  Calcul du moment  angulaire   .....
+
+       radsg    = rad /g
+       radomeg  = rad * omeg
+c
+       DO ij=iip2,ip1jm
+          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
+          omegcosp(ij) = radomeg   * cosphi(ij)
+       ENDDO
+
+c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
+
+       DO l=1,llm
+          DO ij = 1,ip1jm
+             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
+          ENDDO
+          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
+
+          DO ij = 1,ip1jmp1
+             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
+     s        bernf(ij,l)-phi(ij,l))
+          ENDDO
+          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO   ij   = 1, ip1jmp1
+             ge(ij) = masse(ij,l)*teta(ij,l)
+          ENDDO
+          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
+
+          DO ij=1,ip1jmp1
+             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
+          ENDDO
+          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
+
+          DO ij =iip2,ip1jm
+             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
+     *               cosphi(ij)
+          ENDDO
+          angl(l) = radsg *
+     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
+      ENDDO
+
+          DO ij=1,ip1jmp1
+            ge(ij)= ps(ij)*aire(ij)
+          ENDDO
+      ptot  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
+      etot  = SSUM(     llm, etotl, 1 )
+      ztot  = SSUM(     llm, ztotl, 1 )
+      stot  = SSUM(     llm, stotl, 1 )
+      rmsv  = SSUM(     llm, rmsvl, 1 )
+      ang   = SSUM(     llm,  angl, 1 )
+
+c      rday = REAL(INT ( day_ini + time ))
+c
+       rday = REAL(INT(time-jD_ref-jH_ref))
+      IF(ptot0.eq.0.)  THEN
+         PRINT 3500, itau, rday, heure,time
+         PRINT*,'WARNING!!! On recalcule les valeurs initiales de :'
+         PRINT*,'ptot,rmsdpdt,etot,ztot,stot,rmsv,ang'
+         PRINT *, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+         etot0 = etot
+         ptot0 = ptot
+         ztot0 = ztot
+         stot0 = stot
+         ang0  = ang
+      END IF
+
+      etot= etot/etot0
+      rmsv= SQRT(rmsv/ptot)
+      ptot= ptot/ptot0
+      ztot= ztot/ztot0
+      stot= stot/stot0
+      ang = ang /ang0
+
+
+      PRINT 3500, itau, rday, heure, time
+      PRINT 4000, ptot,rmsdpdt,etot,ztot,stot,rmsv,ang
+
+      RETURN
+
+3500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x 
+     *   ,'date',f14.4,4x,10("*"))
+4000   FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
+     * ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB  '
+     .  ,f10.6,e13.6,5f10.3/
+     * )
+      END
+
Index: LMDZ5/trunk/libf/dyn3dmem/sortvarc0.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/sortvarc0.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/sortvarc0.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: sortvarc0.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: sortvarc0.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       SUBROUTINE sortvarc0
Index: LMDZ5/trunk/libf/dyn3dmem/spline.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/spline.F	(revision 1657)
+++ 	(revision )
@@ -1,79 +1,0 @@
-!
-! $Header$
-!
-      subroutine spline(x,y,n,yp1,ypn,y2)
-     
-c
-     
-c     Routine to set up the interpolating function for a cubic spline
-     
-c     interpolation (see "Numerical Recipes" for details).
-     
-c
-	  implicit real (a-h,o-z)
-	  implicit integer (i-n)
-     
-      parameter(nllm=4096)
-     
-      dimension x(n),y(n),y2(n),u(nllm)
-     
-c
-c	write(6,*)(x(i),i=1,n)
-c	write(6,*)(y(i),i=1,n)
-     
-      if(yp1.gt.0.99E30) then
-c the lower boundary condition is set
-       y2(1)=0.
-c either to be "natural"
-       u(1)=0.
-     
-      else
-c or else to have a specified first
-       y2(1)=-0.5
-c derivative
-       u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
-     
-      end if
-     
-      do 11 i=2,n-1
-c decomposition loop of the tridiagonal
-       sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
-c algorithm. Y2 and U are used
-       p=sig*y2(i-1)+2.
-c for temporary storage of the decompo-
-       y2(i)=(sig-1.)/p
-c sed factors
-       u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
-     
-     . /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
-     
- 11   continue
-     
-      if(ypn.gt.0.99E30) then
-c the upper boundary condition is set
-       qn=0.
-c either to be "natural"
-       un=0.
-     
-      else
-c or else to have a specified first
-       qn=0.5
-c derivative
-       un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
-     
-      end if
-     
-      y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
-     
-      do 12 k=n-1,1,-1
-c this is the backsubstitution loop of
-       y2(k)=y2(k)*y2(k+1)+u(k)
-c the tridiagonal algorithm
- 12   continue
-     
-c
-     
-      return
-     
-      end
-     
Index: LMDZ5/trunk/libf/dyn3dmem/splint.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/splint.F	(revision 1657)
+++ 	(revision )
@@ -1,56 +1,0 @@
-!
-! $Header$
-!
-     
-      SUBROUTINE splint(xa,ya,y2a,n,x,y)
-     
-c
-c     Routine to compute a cubic-spline interpolated value Y given the
-c     value of X, the arrays XA, YA and the 2nd derivative array Y2A
-c     computed by SUBROUTINE SPLINE. See "Numerical Recipes" for details
-c
-     
-      IMPLICIT REAL (a-h,o-z)
-      IMPLICIT INTEGER (i-n)
-      DIMENSION xa(n),ya(n),y2a(n)
-     
-      kl0=1
-     
-      khi=n
-c means of bisection
- 1    IF(khi-kl0.gt.1) THEN
-     
-       k=(khi+kl0)/2
-     
-       IF(xa(k).gt.x) THEN
-     
-        khi=k
-     
-       ELSE
-     
-        kl0=k
-     
-       END IF
-     
-       GO TO 1
-     
-      END IF
-c KL0 and KHI now bracket the X
-      h=xa(khi)-xa(kl0)
-     
-      IF(h.eq.0.0) STOP
-      a=(xa(khi)-x)/h
-c evaluation of cubic spline polynomial
-      b=(x-xa(kl0))/h
-     
-      y=a*ya(kl0)+b*ya(khi)+((a**3-a)*y2a(kl0)+(b**3-b)*y2a(khi))*(h**2)
-     
-     ./6.
-     
-c
-     
-      RETURN
-     
-      END
-     
-
Index: LMDZ5/trunk/libf/dyn3dmem/startvar.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/startvar.F	(revision 1657)
+++ 	(revision )
@@ -1,1205 +1,0 @@
-!
-! $Id: startvar.F 1299 2010-01-20 14:27:21Z fairhead $
-!
-      MODULE startvar
-#ifdef CPP_EARTH
-! This module is designed to work for Earth (and with ioipsl)
-    !
-    !
-    !      There are three ways to access data from the database of atmospheric data which 
-    !       can be used to initialize the model. This depends on the type of field which needs 
-    !       to be extracted. 
-    !       We will details the possible arguments to startget here :
-    !
-    !        - A 2D variable on the dynamical grid :
-    !           CALL startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )             
-    !
-    !        - A 1D variable on the physical grid :
-    !            CALL startget_phys1d(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
-    !
-    !
-    !         - A 3D variable on the dynamical grid :
-    !            CALL startget_dyn(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
-    !
-    !
-    !         There is special constraint on the atmospheric data base except that the 
-    !         the data needs to be in netCDF and the variables should have the the following 
-    !        names in the file :
-    !
-    !      'RELIEF'  : High resolution orography 
-    !       'ST'            : Surface temperature
-    !       'CDSW'     : Soil moisture
-    !       'Z'               : Surface geopotential
-    !       'SP'            : Surface pressure
-    !        'U'              : East ward wind
-    !        'V'              : Northward wind
-    !        'TEMP'             : Temperature
-    !        'R'             : Relative humidity
-    !      
-      USE ioipsl
-    !
-    !
-      IMPLICIT NONE
-    !
-    !
-      PRIVATE
-      public startget_phys2d, startget_phys1d, startget_dyn
-    !
-      INTEGER, SAVE :: fid_phys, fid_dyn
-      INTEGER, SAVE  :: iml_phys, iml_rel, iml_dyn
-      INTEGER, SAVE :: jml_phys,  jml_rel, jml_dyn
-      INTEGER, SAVE ::  llm_dyn, ttm_dyn
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lon_phys, lon_rug,
-     . lon_alb, lon_rel, lon_dyn
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lat_phys, lat_rug,
-     . lat_alb, lat_rel, lat_dyn
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:)  :: levdyn_ini
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: relief, zstd, zsig,
-     . zgam, zthe, zpic, zval
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rugo, masque, phis
-    !
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: tsol, qsol, psol_dyn
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:,:)  ::   var_ana3d
-    !
-      CONTAINS
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in,
-     . champ, val_exp, jml2, lon_in2, lat_in2 , interbar, masque_lu )
-    !
-    !    There is a big mess with the size in logitude, should it be iml or iml+1.
-    !    I have chosen to use the iml+1 as an argument to this routine and we declare
-    !   internaly smaler fields when needed. This needs to be cleared once and for all in LMDZ. 
-    !  A convention is required.
-    !
-    !
-      CHARACTER*(*), INTENT(in) :: varname
-      INTEGER, INTENT(in) :: iml, jml ,jml2
-      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
-      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
-      REAL, INTENT(inout) :: champ(iml,jml)
-      REAL, INTENT(in) :: val_exp
-      REAL, INTENT(in), optional :: masque_lu(iml,jml) 
-      LOGICAL interbar
-    !
-    !   This routine only works if the variable does not exist or is constant
-    !
-      IF ( MINVAL(champ(:,:)).EQ.MAXVAL(champ(:,:)) .AND. 
-     .MINVAL(champ(:,:)).EQ.val_exp ) THEN
-          !
-          SELECTCASE(varname)
-              !
-              CASE ('relief')
-                  !
-                  !  If we do not have the orography we need to get it
-                  !
-                  IF ( .NOT.ALLOCATED(relief)) THEN
-                      !
-                    if (present(masque_lu)) then
-                      CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .                    jml2,lon_in2,lat_in2, interbar, masque_lu )
-                    else
-                      CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .                    jml2,lon_in2,lat_in2, interbar)
-                    endif
-                      !
-                  ENDIF
-                  !
-                  IF (SIZE(relief) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*) 'STARTVAR module has been',
-     .' initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  champ(:,:) = relief(:,:)
-                  !
-              CASE ('rugosite')
-                  !
-                  !  If we do not have the orography we need to get it
-                  !
-                  IF ( .NOT.ALLOCATED(rugo)) THEN
-                      !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .                    jml2,lon_in2,lat_in2 , interbar )
-                      !
-                  ENDIF
-                  !
-                  IF (SIZE(rugo) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*) 
-     .  'STARTVAR module has been initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  champ(:,:) = rugo(:,:)
-                  !
-              CASE ('masque')
-                  !
-                  !  If we do not have the orography we need to get it
-                  !
-                  IF ( .NOT.ALLOCATED(masque)) THEN
-                      !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .                     jml2,lon_in2,lat_in2 , interbar )
-                      !
-                  ENDIF
-                  !
-                  IF (SIZE(masque) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*) 
-     .   'STARTVAR module has been initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  champ(:,:) = masque(:,:)
-                  !
-              CASE ('surfgeo')
-                  !
-                  !  If we do not have the orography we need to get it
-                  !
-                  IF ( .NOT.ALLOCATED(phis)) THEN
-                      !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .                   jml2,lon_in2, lat_in2 , interbar )
-                      !
-                  ENDIF
-                  !
-                  IF (SIZE(phis) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  champ(:,:) = phis(:,:)
-                  !
-              CASE ('psol')
-                  !
-                  !  If we do not have the orography we need to get it
-                  !
-                  IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-                      !
-                      CALL start_init_dyn( iml, jml, lon_in, lat_in,
-     .                   jml2,lon_in2, lat_in2 , interbar )
-                      !
-                  ENDIF
-                  !
-                  IF (SIZE(psol_dyn) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  champ(:,:) = psol_dyn(:,:)
-                  !
-              CASE DEFAULT
-                  !
-                  WRITE(*,*) 'startget_phys2d'
-                  WRITE(*,*) 'No rule is present to extract variable', 
-     .                 varname(:LEN_TRIM(varname)),' from any data set'
-                  STOP
-                  !
-          END SELECT
-          !
-      ELSE
-          !
-          ! There are a few fields we might need if we need to interpolate 3D filed. Thus if they come through here we
-          ! will catch them
-          !
-          SELECTCASE(varname)
-              !
-              CASE ('surfgeo')
-                  !
-                  IF ( .NOT.ALLOCATED(phis)) THEN
-                      ALLOCATE(phis(iml,jml))
-                  ENDIF
-                  !
-                  IF (SIZE(phis) .NE. SIZE(champ)) THEN
-                      !
-                      WRITE(*,*)
-     .  'STARTVAR module has been initialized to the wrong size'
-                      STOP
-                      !
-                  ENDIF
-                  !
-                  phis(:,:) = champ(:,:)
-                  !
-          END SELECT
-          !
-      ENDIF
-    !
-      END SUBROUTINE startget_phys2d
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 ,
-     ,   lat_in2 , interbar, masque_lu )
-    !
-      INTEGER, INTENT(in) :: iml, jml, jml2
-      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
-      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
-      REAL, intent(in), optional :: masque_lu(iml,jml)
-      LOGICAL interbar
-    !
-    !  LOCAL
-    !
-      LOGICAL interbar2
-      REAL :: lev(1), date, dt,chmin,chmax
-      INTEGER :: itau(1), fid
-      INTEGER ::  llm_tmp, ttm_tmp
-      INTEGER :: i, j
-      INTEGER :: iret
-      CHARACTER*25 title
-      REAL, ALLOCATABLE :: relief_hi(:,:)
-      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
-      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
-      REAL, ALLOCATABLE :: tmp_var(:,:)
-      INTEGER, ALLOCATABLE :: tmp_int(:,:)
-    !
-      CHARACTER*120 :: orogfname
-      LOGICAL :: check=.TRUE.
-    !
-    !
-      orogfname = 'Relief.nc'
-    !
-      IF ( check ) WRITE(*,*) 'Reading the high resolution orography'
-    !
-      CALL flininfo(orogfname,iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
-    !
-      ALLOCATE (lat_rel(iml_rel,jml_rel), stat=iret)
-      ALLOCATE (lon_rel(iml_rel,jml_rel), stat=iret)
-      ALLOCATE (relief_hi(iml_rel,jml_rel), stat=iret)
-    !
-      CALL flinopen(orogfname, .FALSE., iml_rel, jml_rel, 
-     .llm_tmp, lon_rel, lat_rel, lev, ttm_tmp,
-     .      itau, date, dt, fid)
-    !
-      CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp, 
-     . ttm_tmp, 1, 1, relief_hi)
-    !
-      CALL flinclo(fid)
-    !
-    !   In case we have a file which is in degrees we do the transformation
-    !
-      ALLOCATE(lon_rad(iml_rel))
-      ALLOCATE(lon_ini(iml_rel))
-
-      IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_ini(:) = lon_rel(:,1) 
-      ENDIF
-
-      ALLOCATE(lat_rad(jml_rel))
-      ALLOCATE(lat_ini(jml_rel))
-
-      IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_ini(:) = lat_rel(1,:) 
-      ENDIF
-    !
-    !
-
-      title='RELIEF'
-
-      interbar2 = .FALSE.
-      CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini,
-     . lon_rad, lat_rad, relief_hi , interbar2  )
-
-      IF ( check ) WRITE(*,*) 'Computes all the parameters needed',
-     .' for the gravity wave drag code'
-    !
-    !    Allocate the data we need to put in the interpolated fields
-    !
-    !            RELIEF:  orographie moyenne
-      ALLOCATE(relief(iml,jml))
-    !            zphi :  orographie moyenne
-      ALLOCATE(phis(iml,jml))
-    !             zstd:  deviation standard de l'orographie sous-maille
-      ALLOCATE(zstd(iml,jml))
-    !             zsig:  pente de l'orographie sous-maille 
-      ALLOCATE(zsig(iml,jml))
-    !             zgam:  anisotropy de l'orographie sous maille
-      ALLOCATE(zgam(iml,jml))
-    !             zthe:  orientation de l'axe oriente dans la direction
-    !                    de plus grande pente de l'orographie sous maille
-      ALLOCATE(zthe(iml,jml))
-    !             zpic:  hauteur pics de la SSO
-      ALLOCATE(zpic(iml,jml))
-    !             zval:  hauteur vallees de la SSO
-      ALLOCATE(zval(iml,jml))
-    !             masque : Masque terre ocean
-      ALLOCATE(tmp_int(iml,jml))
-      ALLOCATE(masque(iml,jml))
-
-      masque = -99999.
-      if (present(masque_lu)) then
-        masque = masque_lu
-      endif
-    !
-      CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
-     . iml-1, jml, lon_in, lat_in, 
-     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
-      phis = phis * 9.81
-    !
-!      masque(:,:) = REAL(tmp_int(:,:))
-    !
-    !  Compute surface roughness
-    !
-      IF ( check ) WRITE(*,*) 
-     .'Compute surface roughness induced by the orography'
-    !
-      ALLOCATE(rugo(iml,jml))
-      ALLOCATE(tmp_var(iml-1,jml))
-    !
-      CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
-     . iml-1, jml, lon_in, lat_in, tmp_var)
-    !
-      DO j = 1, jml
-        DO i = 1, iml-1
-          rugo(i,j) = tmp_var(i,j)
-        ENDDO
-        rugo(iml,j) = tmp_var(1,j)
-      ENDDO
-c
-cc   ***   rugo  n'est pas utilise pour l'instant  ******
-    !
-    !   Build land-sea mask
-    !
-    !
-      RETURN
-    !
-      END SUBROUTINE start_init_orog
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, 
-     .lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar)
-    !
-      CHARACTER*(*), INTENT(in) :: varname
-      INTEGER, INTENT(in) :: iml, jml, nbindex, jml2
-      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
-      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
-      REAL, INTENT(inout) :: champ(nbindex)
-      REAL, INTENT(in) :: val_exp
-      LOGICAL interbar
-    !
-    !
-    !   This routine only works if the variable does not exist or is constant
-    !
-      IF ( MINVAL(champ(:)).EQ.MAXVAL(champ(:)) .AND. 
-     .MINVAL(champ(:)).EQ.val_exp ) THEN
-          SELECTCASE(varname)
-            CASE ('tsol')
-              IF ( .NOT.ALLOCATED(tsol)) THEN
-                CALL start_init_phys( iml, jml, lon_in, lat_in,
-     .              jml2, lon_in2, lat_in2, interbar )
-              ENDIF
-              IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*) 
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex, tsol, champ)
-            CASE ('qsol')
-              IF ( .NOT.ALLOCATED(qsol)) THEN
-                CALL start_init_phys( iml, jml, lon_in, lat_in,
-     .              jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*) 
-     . 'STARTVAR module has been initialized to the wrong size'
-                STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex, qsol, champ)
-            CASE ('psol')
-              IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-                CALL start_init_dyn( iml, jml, lon_in, lat_in,
-     .              jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN
-                WRITE(*,*) 
-     . 'STARTVAR module has been initialized to the wrong size'
-                STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex, psol_dyn, champ)
-            CASE ('zmea')
-              IF ( .NOT.ALLOCATED(relief)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .            jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex, relief, champ)
-            CASE ('zstd')
-              IF ( .NOT.ALLOCATED(zstd)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .              jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zstd, champ)
-            CASE ('zsig')
-              IF ( .NOT.ALLOCATED(zsig)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .               jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zsig, champ)
-            CASE ('zgam')
-              IF ( .NOT.ALLOCATED(zgam)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .            jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zgam, champ)
-            CASE ('zthe')
-              IF ( .NOT.ALLOCATED(zthe)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .            jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zthe, champ)
-            CASE ('zpic')
-              IF ( .NOT.ALLOCATED(zpic)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .            jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zpic, champ)
-            CASE ('zval')
-              IF ( .NOT.ALLOCATED(zval)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in,
-     .            jml2, lon_in2,lat_in2 , interbar )
-              ENDIF
-              IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
-                WRITE(*,*)
-     . 'STARTVAR module has been initialized to the wrong size'
-                 STOP
-              ENDIF
-              CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ)
-            CASE ('rads')
-                  champ(:) = 0.0
-            CASE ('snow')
-                  champ(:) = 0.0
-cIM "slab" ocean
-            CASE ('tslab')
-                   champ(:) = 0.0
-            CASE ('seaice')
-                  champ(:) = 0.0
-            CASE ('rugmer')
-                  champ(:) = 0.001
-            CASE ('agsno')
-                  champ(:) = 50.0
-            CASE DEFAULT
-              WRITE(*,*) 'startget_phys1d'
-              WRITE(*,*) 'No rule is present to extract variable  ',
-     . varname(:LEN_TRIM(varname)),' from any data set'
-              STOP
-          END SELECT
-      ELSE
-        !
-        ! If we see tsol we catch it as we may need it for a 3D interpolation
-        !
-        SELECTCASE(varname)
-          CASE ('tsol')
-            IF ( .NOT.ALLOCATED(tsol)) THEN
-              ALLOCATE(tsol(SIZE(lon_in),SIZE(lat_in) ))
-            ENDIF
-            CALL gr_fi_dyn(1, iml, jml, nbindex, champ, tsol)
-        END SELECT
-      ENDIF
-      END SUBROUTINE startget_phys1d
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
-     .                 lon_in2, lat_in2 , interbar )
-
-      use inter_barxy_m, only: inter_barxy
-    !
-      INTEGER, INTENT(in) :: iml, jml ,jml2
-      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
-      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
-      LOGICAL interbar
-    !
-    !  LOCAL
-    !
-!ac     REAL :: lev(1), date, dt
-      REAL :: date, dt
-      REAL, DIMENSION(:), ALLOCATABLE :: levphys_ini
-!ac
-      INTEGER :: itau(1)
-      INTEGER ::  llm_tmp, ttm_tmp
-      INTEGER :: i, j
-    !
-      CHARACTER*25 title
-      CHARACTER*120 :: physfname
-      LOGICAL :: check=.TRUE.
-    !
-      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
-      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
-      REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:)
-    !
-      physfname = 'ECPHY.nc'
-    !
-      IF ( check ) WRITE(*,*) 'Opening the surface analysis'
-    !
-      CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp,
-     . ttm_tmp, fid_phys)
-    !
-      ALLOCATE (lat_phys(iml_phys,jml_phys))
-      ALLOCATE (lon_phys(iml_phys,jml_phys))
-!ac
-      ALLOCATE (levphys_ini(llm_tmp))
-    !
-!      CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, 
-!     . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp, 
-!     . itau, date, dt, fid_phys)
-    !
-      CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, 
-     . llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp, 
-     . itau, date, dt, fid_phys)
-    !
-      DEALLOCATE (levphys_ini)
-!ac
-    !
-    ! Allocate the space we will need to get the data out of this file
-    !
-      ALLOCATE(var_ana(iml_phys, jml_phys))
-    !
-    !   In case we have a file which is in degrees we do the transformation
-    !
-      ALLOCATE(lon_rad(iml_phys))
-      ALLOCATE(lon_ini(iml_phys))
-
-      IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_ini(:) = lon_phys(:,1) 
-      ENDIF
-
-      ALLOCATE(lat_rad(jml_phys))
-      ALLOCATE(lat_ini(jml_phys))
-
-      IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_ini(:) = lat_phys(1,:) 
-      ENDIF
-
-
-    !
-    !   We get the two standard varibales
-    !   Surface temperature
-    !
-      ALLOCATE(tsol(iml,jml))
-      ALLOCATE(tmp_var(iml-1,jml))
-    !
-    !
-
-      CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, 
-     .llm_tmp, ttm_tmp, 1, 1, var_ana)
-
-      title='ST'
-      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
-     . lon_rad, lat_rad, var_ana , interbar  )
-
-      IF ( interbar )   THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour  ST $$$ '
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
-     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var) 
-      ELSE
-        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
-     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
-      ENDIF
-
-      CALL gr_int_dyn(tmp_var, tsol, iml-1, jml)
-    !
-    ! Soil moisture
-    !
-      ALLOCATE(qsol(iml,jml))
-      CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys,
-     . llm_tmp, ttm_tmp, 1, 1, var_ana)
-
-      title='CDSW'
-      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
-     . lon_rad, lat_rad, var_ana, interbar  )
-
-      IF ( interbar )   THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour  CDSW $$$ '
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana,
-     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var) 
-      ELSE
-        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
-     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
-      ENDIF
-c
-        CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
-    !
-       CALL flinclo(fid_phys)
-    !
-      END SUBROUTINE start_init_phys
-    !
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-    !
-      SUBROUTINE startget_dyn(varname, lon_in, lat_in,
-     . pls, workvar, champ, val_exp, lon_in2, lat_in2 ,
-     ,  interbar )
-
-      use assert_eq_m, only: assert_eq
-    !
-    !   ARGUMENTS
-    !
-      CHARACTER(len=*), INTENT(in) :: varname
-      REAL, INTENT(in) :: lon_in(:) ! dim(iml)
-      REAL, INTENT(in) :: lat_in(:) ! dim(jml)
-      REAL, INTENT(in) :: lon_in2(:) ! dim(iml)
-      REAL, INTENT(in) :: lat_in2(:) ! dim(jml2)
-      REAL, INTENT(in) :: pls(:, :, :) ! dim(iml, jml, lml)
-      REAL, INTENT(in) :: workvar(:, :, :) ! dim(iml, jml, lml)
-      REAL, INTENT(inout) :: champ(:, :, :) ! dim(iml, jml, lml)
-      REAL, INTENT(in) :: val_exp
-      LOGICAL interbar
-    !
-    !    LOCAL
-    !
-      INTEGER :: il, ij, ii, iml, jml, lml, jml2
-      REAL :: xppn, xpps
-    !
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-#include "comconst.h"
-    !
-    !   This routine only works if the variable does not exist or is constant
-    !
-C     -----------------------------
-
-      iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1),
-     $     size(champ, 1), size(lon_in2)/), "startget_dyn iml")
-      jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2),
-     $     size(champ, 2), "startget_dyn jml")
-      lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3),
-     $     "startget_dyn lml")
-      jml2 = size(lat_in2)
-
-      IF ( MINVAL(champ(:,:,:)).EQ.MAXVAL(champ(:,:,:)) .AND.
-     . MINVAL(champ(:,:,:)).EQ.val_exp ) THEN
-        !
-        SELECTCASE(varname)
-          CASE ('u')
-            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
-     .          lon_in2,lat_in2 , interbar )
-            ENDIF
-            CALL start_inter_3d('U', iml, jml, lml, lon_in,
-     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ,interbar )
-            DO il=1,lml
-              DO ij=1,jml
-                DO ii=1,iml-1
-                  champ(ii,ij,il) = champ(ii,ij,il) * cu(ii,ij)
-                ENDDO
-                champ(iml,ij, il) = champ(1,ij, il)
-              ENDDO
-            ENDDO
-          CASE ('v')
-            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2, 
-     .           lon_in2, lat_in2 , interbar )
-            ENDIF
-            CALL start_inter_3d('V', iml, jml, lml, lon_in, 
-     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
-            DO il=1,lml
-              DO ij=1,jml
-                DO ii=1,iml-1
-                  champ(ii,ij,il) = champ(ii,ij,il) * cv(ii,ij)
-                ENDDO
-                champ(iml,ij, il) = champ(1,ij, il)
-              ENDDO
-            ENDDO
-          CASE ('t')
-            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
-     .           lon_in2, lat_in2 ,interbar )
-            ENDIF
-            CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
-     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
- 
-          CASE ('tpot')
-            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 ,
-     .            lon_in2, lat_in2 , interbar )
-            ENDIF
-            CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
-     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
-            IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
-     .                                    THEN
-              DO il=1,lml
-                DO ij=1,jml
-                  DO ii=1,iml-1
-                    champ(ii,ij,il) = champ(ii,ij,il) * cpp 
-     .                                 / workvar(ii,ij,il)
-                  ENDDO
-                  champ(iml,ij,il) = champ(1,ij,il)
-                ENDDO
-              ENDDO
-              DO il=1,lml
-                xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
-                champ(:,1,il) = xppn
-                champ(:,jml,il) = xpps
-              ENDDO
-            ELSE
-              WRITE(*,*)'Could not compute potential temperature as the'
-              WRITE(*,*)'Exner function is missing or constant.'
-              STOP
-            ENDIF
-          CASE ('q')
-            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
-     .           lon_in2, lat_in2 , interbar )
-            ENDIF
-            CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in,
-     .        jml2, lon_in2, lat_in2,  pls, champ, interbar )
-            IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) 
-     .                                     THEN
-              DO il=1,lml
-                DO ij=1,jml
-                  DO ii=1,iml-1
-                    champ(ii,ij,il) = 0.01 * champ(ii,ij,il) *
-     .                                       workvar(ii,ij,il)
-                  ENDDO
-                  champ(iml,ij,il) = champ(1,ij,il)
-                ENDDO
-              ENDDO
-              WHERE ( champ .LT. 0.) champ = 1.0E-10
-              DO il=1,lml
-                xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
-                champ(:,1,il) = xppn
-                champ(:,jml,il) = xpps
-              ENDDO
-            ELSE
-              WRITE(*,*)'Could not compute specific humidity as the'
-              WRITE(*,*)'saturated humidity is missing or constant.'
-              STOP
-            ENDIF
-          CASE DEFAULT
-            WRITE(*,*) 'startget_dyn'
-            WRITE(*,*) 'No rule is present to extract variable  ',
-     . varname(:LEN_TRIM(varname)),' from any data set'
-            STOP
-          END SELECT
-      ENDIF
-      END SUBROUTINE startget_dyn
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 ,
-     ,             lat_in2 , interbar )
-    !
-      use inter_barxy_m, only: inter_barxy
-
-      INTEGER, INTENT(in) :: iml, jml, jml2
-      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
-      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
-      LOGICAL interbar
-    !
-    !  LOCAL
-    !
-      REAL :: lev(1), date, dt
-      INTEGER :: itau(1)
-      INTEGER :: i, j
-      integer :: iret
-    !
-      CHARACTER*120 :: physfname
-      LOGICAL :: check=.TRUE.
-    !
-      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
-      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
-      REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:)
-      REAL, ALLOCATABLE :: xppn(:), xpps(:)
-      LOGICAL :: allo
-    !
-    !
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom2.h"
-
-      CHARACTER*25 title
-
-    !
-      physfname = 'ECDYN.nc'
-    !
-      IF ( check ) WRITE(*,*) 'Opening the surface analysis'
-    !
-      CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn,
-     .                            ttm_dyn, fid_dyn)
-      IF ( check ) WRITE(*,*) 'Values read: ', iml_dyn, jml_dyn, 
-     .                                         llm_dyn, ttm_dyn
-    !
-      ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret)
-      ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret)
-      ALLOCATE (levdyn_ini(llm_dyn), stat=iret)
-    !
-      CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,
-     . lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, 
-     . itau, date, dt, fid_dyn)
-    !
-
-      allo = allocated (var_ana)
-      if (allo) then
-        DEALLOCATE(var_ana, stat=iret)
-      endif
-      ALLOCATE(var_ana(iml_dyn, jml_dyn), stat=iret)
-
-      allo = allocated (lon_rad)
-      if (allo) then
-        DEALLOCATE(lon_rad, stat=iret)
-      endif
-
-      ALLOCATE(lon_rad(iml_dyn), stat=iret)
-      ALLOCATE(lon_ini(iml_dyn))
-       
-      IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_ini(:) = lon_dyn(:,1) 
-      ENDIF
-
-      ALLOCATE(lat_rad(jml_dyn))
-      ALLOCATE(lat_ini(jml_dyn))
-
-      IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_ini(:) = lat_dyn(1,:) 
-      ENDIF
-    !
-
-
-      ALLOCATE(z(iml, jml))
-      ALLOCATE(tmp_var(iml-1,jml))
-    !
-      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn,
-     .              1, 1, var_ana)
-c
-      title='Z'
-      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
-     . lon_rad, lat_rad, var_ana, interbar  )
-c
-      IF ( interbar )   THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour  Z  $$$ '
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
-     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var) 
-      ELSE
-        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
-     .               iml-1, jml, lon_in, lat_in, tmp_var)
-      ENDIF
-
-      CALL gr_int_dyn(tmp_var, z, iml-1, jml)
-    !
-      ALLOCATE(psol_dyn(iml, jml))
-    !
-      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn,
-     .              1, 1, var_ana)
-
-       title='SP'
-      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
-     . lon_rad, lat_rad, var_ana, interbar  )
-
-      IF ( interbar )   THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour  SP  $$$ '
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana,
-     $       lon_in2(:iml-1), lat_in2(:jml-1), tmp_var) 
-      ELSE
-        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
-     .             iml-1, jml, lon_in, lat_in, tmp_var  )
-      ENDIF
-
-      CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml)
-    !
-      IF ( .NOT.ALLOCATED(tsol)) THEN
-    !   These variables may have been allocated by the need to 
-    !   create a start field for them or by the varibale
-    !   coming out of the restart file. In case we dor have it we will initialize it.
-    !
-        CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2,
-     .                 lat_in2 , interbar )
-      ELSE
-        IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN
-        WRITE(*,*) 'start_init_dyn :'
-        WRITE(*,*) 'The temperature field we have does not ',
-     .             'have the right size'
-        STOP
-      ENDIF
-      ENDIF
-      IF ( .NOT.ALLOCATED(phis)) THEN
-            !
-            !    These variables may have been allocated by the need to create a start field for them or by the varibale
-            !     coming out of the restart file. In case we dor have it we will initialize it.
-            !
-        CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 ,
-     .      lat_in2 , interbar )
-            !
-      ELSE
-            !
-          IF (SIZE(phis) .NE. SIZE(psol_dyn)) THEN
-                !
-              WRITE(*,*) 'start_init_dyn :'
-              WRITE(*,*) 'The orography field we have does not ',
-     .                   ' have the right size'
-              STOP
-          ENDIF
-            !
-      ENDIF
-    !
-    !     PSOL is computed in Pascals
-    !
-    !
-      DO j = 1, jml
-        DO i = 1, iml-1
-          psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j)) 
-     .                    /287.0/tsol(i,j))
-        ENDDO
-        psol_dyn(iml,j) = psol_dyn(1,j)
-      ENDDO
-    !
-    !
-      ALLOCATE(xppn(iml-1))
-      ALLOCATE(xpps(iml-1)) 
-    !
-      DO  i   = 1, iml-1
-        xppn(i) = aire( i,1) * psol_dyn( i,1)
-        xpps(i) = aire( i,jml) * psol_dyn( i,jml)
-      ENDDO
-    !
-      DO i   = 1, iml
-        psol_dyn(i,1    )  = SUM(xppn)/apoln
-        psol_dyn(i,jml)  = SUM(xpps)/apols
-      ENDDO
-    !
-      RETURN
-    !
-      END SUBROUTINE start_init_dyn
-    !
-    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-    !
-      SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in,
-     .      lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar )
-    !
-    !    This subroutine gets a variables from a 3D file and does the interpolations needed
-    !
-    !
-      use inter_barxy_m, only: inter_barxy
-
-    !    ARGUMENTS
-    !
-      CHARACTER*(*) :: varname
-      INTEGER :: iml, jml, lml, jml2
-      REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml)
-      REAL :: lon_in2(iml) , lat_in2(jml2)
-      REAL :: var3d(iml, jml, lml)
-      LOGICAL interbar
-      real chmin,chmax
-    !
-    !  LOCAL
-    !
-      CHARACTER*25 title
-      INTEGER :: ii, ij, il, jsort,i,j,l
-      REAL :: bx, by
-      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
-      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:)
-      REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:)
-      REAL, ALLOCATABLE :: ax(:), ay(:), yder(:)
-!       REAL, ALLOCATABLE :: varrr(:,:,:)
-      INTEGER, ALLOCATABLE :: lind(:)
-    !
-      LOGICAL :: check = .TRUE.
-    !
-      IF ( .NOT. ALLOCATED(var_ana3d)) THEN
-          ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
-      ENDIF
-!          ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn))
-    !
-    !
-      IF ( check) WRITE(*,*) 'Going into flinget to extract the 3D ',
-     .  ' field.', fid_dyn
-      IF ( check) WRITE(*,*) fid_dyn, varname, iml_dyn, jml_dyn,
-     .                        llm_dyn,ttm_dyn
-    !
-      CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, 
-     . ttm_dyn, 1, 1, var_ana3d)
-    !
-      IF ( check) WRITE(*,*) 'Allocating space for the interpolation',
-     . iml, jml, llm_dyn
-    !
-      ALLOCATE(lon_rad(iml_dyn))
-      ALLOCATE(lon_ini(iml_dyn))
-
-      IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_ini(:) = lon_dyn(:,1) 
-      ENDIF
-
-      ALLOCATE(lat_rad(jml_dyn))
-      ALLOCATE(lat_ini(jml_dyn))
-
-      ALLOCATE(lev_dyn(llm_dyn))
-
-      IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_ini(:) = lat_dyn(1,:) 
-      ENDIF
-    !
-
-      CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini, 
-     . lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d  ,
-     ,  interbar                                                   )
-
-      ALLOCATE(var_tmp2d(iml-1, jml))
-      ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
-      ALLOCATE(ax(llm_dyn))
-      ALLOCATE(ay(llm_dyn))
-      ALLOCATE(yder(llm_dyn))
-      ALLOCATE(lind(llm_dyn))
-    !
- 
-      DO il=1,llm_dyn
-        !
-      IF( interbar )  THEN
-       IF( il.EQ.1 )  THEN
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
-     , ' pour ', varname
-        WRITE(6,*) '-------------------------------------------------',
-     ,'--------------'
-       ENDIF
-       CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1),
-     $      var_ana3d(:,:,il), lon_in2(:iml-1), lat_in2, var_tmp2d) 
-      ELSE
-       CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, 
-     .  var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d )
-      ENDIF
-        !
-        CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml)
-        !
-       ENDDO
-       !
-          DO il=1,llm_dyn
-            lind(il) = llm_dyn-il+1
-          ENDDO
-    !
-c
-c  ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere
-c                    vers  le  sol  ...
-c
-      DO ij=1,jml
-        DO ii=1,iml-1
-          !
-          ax(:) = lev_dyn(lind(:)) 
-          ay(:) = var_tmp3d(ii, ij, lind(:))
-          !
-         
-          CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder)
-          !
-          DO il=1,lml
-            bx = pls_in(ii, ij, il)
-            CALL SPLINT(ax, ay, yder, llm_dyn, bx, by)
-            var3d(ii, ij, il) = by
-          ENDDO
-          !
-        ENDDO
-        var3d(iml, ij, :) = var3d(1, ij, :) 
-      ENDDO
-
-      do il=1,lml
-        call minmax(iml*jml,var3d(1,1,il),chmin,chmax)
-      SELECTCASE(varname)
-       CASE('U')
-          WRITE(*,*) ' U  min max l ',il,chmin,chmax
-       CASE('V')
-          WRITE(*,*) ' V  min max l ',il,chmin,chmax
-       CASE('TEMP')
-          WRITE(*,*) ' TEMP  min max l ',il,chmin,chmax
-       CASE('R')
-          WRITE(*,*) ' R  min max l ',il,chmin,chmax
-      END SELECT
-           enddo
-
-      DEALLOCATE(lon_rad)
-      DEALLOCATE(lon_ini)
-      DEALLOCATE(lat_rad)
-      DEALLOCATE(lat_ini)
-      DEALLOCATE(lev_dyn)
-      DEALLOCATE(var_tmp2d)
-      DEALLOCATE(var_tmp3d)
-      DEALLOCATE(ax)
-      DEALLOCATE(ay)
-      DEALLOCATE(yder)
-      DEALLOCATE(lind)
-
-    !
-      RETURN
-    !
-      END SUBROUTINE start_inter_3d
-    !
-#endif
-! of #ifdef CPP_EARTH
-      END MODULE startvar
Index: LMDZ5/trunk/libf/dyn3dmem/startvar.F90
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/startvar.F90	(revision 1658)
+++ LMDZ5/trunk/libf/dyn3dmem/startvar.F90	(revision 1658)
@@ -0,0 +1,783 @@
+!
+! $Id: startvar.F90 1425 2010-09-02 13:45:23Z lguez $
+!
+!*******************************************************************************
+!
+MODULE startvar
+!
+!*******************************************************************************
+!
+!-------------------------------------------------------------------------------
+! Purpose: Access data from the database of atmospheric to initialize the model.
+!-------------------------------------------------------------------------------
+! Comments:
+!
+!    *  This module is designed to work for Earth (and with ioipsl)
+!
+!    *  There are three ways to acces data, depending on the type of field
+!  which needs to be extracted. In any case the call should come after a restget
+!  and should be of the type :                     CALL startget(...)
+!
+!  - A 1D variable on the physical grid :
+!    CALL startget_phys1d((varname, iml, jml,  lon_in,  lat_in,  nbindex,              &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
+!
+!  - A 2D variable on the dynamical grid :
+!    CALL startget_phys2d(varname, iml, jml,  lon_in,  lat_in,                        &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )             
+!
+!  - A 3D variable on the dynamical grid :
+!    CALL startget_dyn((varname, iml, jml,  lon_in,  lat_in,  lml, pls, workvar,    &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
+!
+!    *  Data needs to be in NetCDF format
+!
+!    *  Variables should have the following names in the files:
+!            'RELIEF' : High resolution orography 
+!            'ST'     : Surface temperature
+!            'CDSW'   : Soil moisture
+!            'Z'      : Surface geopotential
+!            'SP'     : Surface pressure
+!            'U'      : East ward wind
+!            'V'      : Northward wind
+!            'TEMP'   : Temperature
+!            'R'      : Relative humidity
+!
+!   *   There is a big mess with the longitude size. Should it be iml or iml+1 ?
+!  I have chosen to use the iml+1 as an argument to this routine and we declare
+!  internaly smaller fields when needed. This needs to be cleared once and for
+!  all in LMDZ. A convention is required.
+!-------------------------------------------------------------------------------
+#ifdef CPP_EARTH
+  USE ioipsl
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC startget_phys2d, startget_phys1d, startget_dyn
+!  INTERFACE startget
+!    MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn
+!  END INTERFACE
+
+  REAL,    SAVE :: deg2rad,  pi
+  INTEGER, SAVE ::           iml_rel,  jml_rel
+  INTEGER, SAVE :: fid_phys, iml_phys, jml_phys
+  INTEGER, SAVE :: fid_dyn,  iml_dyn,  jml_dyn,  llm_dyn,  ttm_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lon_phys, lon_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lat_phys, lat_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lon_rug, lon_alb, lon_rel
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lat_rug, lat_alb, lat_rel
+  REAL, DIMENSION(:),     ALLOCATABLE, TARGET, SAVE :: levdyn_ini
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: relief, zstd, zsig, zgam
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: masque, zthe, zpic, zval
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: rugo, phis, tsol, qsol
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: psol_dyn
+  REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET, SAVE :: var_ana3d
+
+   CONTAINS
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, lat_in, nbindex, champ,  &
+                           val_exp ,jml2, lon_in2, lat_in2, ibar)
+!
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),         INTENT(IN)    :: varname
+  INTEGER,                  INTENT(IN)    :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)    :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)    :: lat_in
+  INTEGER,                  INTENT(IN)    :: nbindex
+  REAL, DIMENSION(nbindex), INTENT(INOUT) :: champ
+  REAL,                     INTENT(IN)    :: val_exp
+  INTEGER,                  INTENT(IN)    :: jml2
+  REAL, DIMENSION(iml),     INTENT(IN)    :: lon_in2
+  REAL, DIMENSION(jml2),    INTENT(IN)    :: lat_in2
+  LOGICAL,                  INTENT(IN)    :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(:,:), POINTER :: v2d
+!-------------------------------------------------------------------------------
+  v2d=>NULL()
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+!--- CHECKING IF THE FIELD IS KNOWN ; READING UNALLOCATED FILES
+    SELECT CASE(varname)
+      CASE('tsol')
+        IF(.NOT.ALLOCATED(tsol))                                               &
+         CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('qsol')
+        IF(.NOT.ALLOCATED(qsol))                                               &
+         CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('psol')
+        IF(.NOT.ALLOCATED(psol_dyn))                                           &
+         CALL start_init_dyn (iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('zmea','zstd','zsig','zgam','zthe','zpic','zval')
+        IF(.NOT.ALLOCATED(relief))                                             &
+         CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('rads','snow','tslab','seaice','rugmer','agsno')
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_phys1d'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                     //' from any data set'; STOP
+    END SELECT
+
+!--- SELECTING v2d FOR WANTED VARIABLE AND CHEKING ITS SIZE
+    SELECT CASE(varname)
+      CASE('rads','snow','tslab','seaice');  champ=0.0
+      CASE('rugmer');                        champ(:)=0.001
+      CASE('agsno');                         champ(:)=50.0
+      CASE DEFAULT
+        SELECT CASE(varname)
+          CASE('tsol'); v2d=>tsol
+          CASE('qsol'); v2d=>qsol
+          CASE('psol'); v2d=>psol_dyn
+          CASE('zmea'); v2d=>relief
+          CASE('zstd'); v2d=>zstd
+          CASE('zsig'); v2d=>zsig
+          CASE('zgam'); v2d=>zgam
+          CASE('zthe'); v2d=>zthe
+          CASE('zpic'); v2d=>zpic
+          CASE('zval'); v2d=>zval
+        END SELECT
+        IF(SIZE(v2d)/=SIZE(lon_in)*SIZE(lat_in)) THEN
+         WRITE(lunout,*)'STARTVAR module has been initialized to the wrong size'
+         STOP
+        END IF
+        CALL gr_dyn_fi(1,iml,jml,nbindex,v2d,champ)
+    END SELECT
+
+  ELSE
+
+!--- SOME FIELDS ARE CAUGHT: MAY BE NEEDED FOR A 3D INTEPROLATION
+    SELECT CASE(varname)
+      CASE('tsol')
+        IF(.NOT.ALLOCATED(tsol)) ALLOCATE(tsol(iml,jml))
+        CALL gr_fi_dyn(1,iml,jml,nbindex,champ,tsol)
+    END SELECT
+
+  END IF
+
+END SUBROUTINE  startget_phys1d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_exp,  &
+                           jml2, lon_in2, lat_in2 , ibar, msk)
+!
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),         INTENT(IN)           :: varname
+  INTEGER,                  INTENT(IN)           :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)           :: lat_in
+  REAL, DIMENSION(iml,jml), INTENT(INOUT)        :: champ
+  REAL,                     INTENT(IN)           :: val_exp
+  INTEGER,                  INTENT(IN)           :: jml2
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in2
+  REAL, DIMENSION(jml2),    INTENT(IN)           :: lat_in2
+  LOGICAL,                  INTENT(IN)           :: ibar
+  REAL, DIMENSION(iml,jml), INTENT(IN), OPTIONAL :: msk
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(:,:), POINTER :: v2d=>NULL()
+  LOGICAL                       :: lrelief1, lrelief2
+!-------------------------------------------------------------------------------
+  v2d=>NULL()
+  lrelief1=(.NOT.ALLOCATED(relief).AND.     PRESENT(msk))
+  lrelief2=(.NOT.ALLOCATED(relief).AND..NOT.PRESENT(msk))
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+!--- CHECKING IF THE FIELD IS KNOWN ; READING UNALLOCATED FILES
+    SELECT CASE(varname)
+      CASE('psol')
+        IF(.NOT.ALLOCATED(psol_dyn))                                           &
+          CALL start_init_dyn (iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('relief')
+        IF(lrelief1)             CALL start_init_orog(iml,jml,lon_in,lat_in,msk)
+        IF(lrelief2)             CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('surfgeo')
+        IF(.NOT.ALLOCATED(phis)) CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('rugosite','masque')
+        IF(.NOT.ALLOCATED(rugo)) CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_phys2d'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                     //' from any data set'; STOP
+    END SELECT
+
+!--- SELECTING v2d FOR WANTED VARIABLE AND CHEKING ITS SIZE
+    SELECT CASE(varname)
+      CASE('psol');     v2d=>psol_dyn
+      CASE('relief');   v2d=>relief
+      CASE('rugosite'); v2d=>rugo
+      CASE('masque');   v2d=>masque
+      CASE('surfgeo');  v2d=>phis
+    END SELECT
+    IF(SIZE(champ)/=SIZE(v2d)) THEN
+      WRITE(lunout,*) 'STARTVAR module has been initialized to the wrong size'
+      STOP
+    END IF
+
+    champ(:,:)=v2d(:,:)
+
+  ELSE
+
+!--- SOME FIELDS ARE CAUGHT: MAY BE NEEDED FOR A 3D INTEPROLATION
+    SELECT CASE(varname)
+      CASE ('surfgeo')
+        IF(.NOT.ALLOCATED(phis)) ALLOCATE(phis(iml,jml))
+        IF(SIZE(phis)/=SIZE(champ)) THEN
+         WRITE(lunout,*)'STARTVAR module has been initialized to the wrong size'
+         STOP
+        END IF
+        phis(:,:)=champ(:,:)
+    END SELECT
+
+  END IF
+
+END SUBROUTINE startget_phys2d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_dyn(varname,  lon_in,  lat_in, pls,workvar,&
+                     champ, val_exp, lon_in2, lat_in2, ibar)
+
+      use assert_eq_m, only: assert_eq
+
+
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN)    :: varname
+  REAL, INTENT(IN)    :: lon_in(:) ! dim(iml)
+  REAL, INTENT(IN)    :: lat_in(:) ! dim(jml)
+  REAL, INTENT(IN)    :: pls(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(IN)    :: workvar(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(INOUT) :: champ(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(IN)    :: val_exp
+  REAL, INTENT(IN)    :: lon_in2(:) ! dim(iml)
+  REAL, INTENT(IN)    :: lat_in2(:) ! dim(jml2)
+  LOGICAL,                      INTENT(IN)    :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+#include "dimensions.h"
+#include "comconst.h"
+#include "paramet.h"
+#include "comgeom2.h"
+  INTEGER    :: iml, jml
+  INTEGER    :: lml
+  INTEGER    :: jml2
+  REAL, DIMENSION(:,:,:), POINTER :: v3d=>NULL()
+  CHARACTER(LEN=10) :: vname
+  INTEGER :: il
+  REAL    :: xppn, xpps
+!-------------------------------------------------------------------------------
+  NULLIFY(v3d)
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+      iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1), &
+     &     size(champ, 1), size(lon_in2)/), "startget_dyn iml")
+      jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2),   &
+     &     size(champ, 2), "startget_dyn jml")
+      lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3), &
+     &     "startget_dyn lml")
+      jml2 = size(lat_in2)
+
+!--- READING UNALLOCATED FILES
+    IF(.NOT.ALLOCATED(psol_dyn))                                               &
+      CALL start_init_dyn(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+
+!--- CHECKING IF THE FIELD IS KNOWN AND INTERPOLATING 3D FIELDS
+    SELECT CASE(varname)
+      CASE('u');        vname='U'
+      CASE('v');        vname='V'
+      CASE('t','tpot'); vname='TEMP'
+      CASE('q');        vname='R'
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_dyn'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                //' from any data set'; STOP
+    END SELECT
+    CALL start_inter_3d(TRIM(vname), iml, jml, lml, lon_in, lat_in, jml2,      &
+                        lon_in2, lat_in2,  pls, champ,ibar )
+
+!--- COMPUTING THE REQUIRED FILED
+    SELECT CASE(varname)
+      CASE('u')                                            !--- Eastward wind
+        DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
+        champ(iml,:,:)=champ(1,:,:)
+
+      CASE('v')                                            !--- Northward wind
+        DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
+        champ(iml,:,:)=champ(1,:,:)
+
+      CASE('tpot')                                         !--- Temperature
+        IF(MINVAL(workvar)/=MAXVAL(workvar)) THEN
+          champ=champ*cpp/workvar
+          DO il=1,lml
+            xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
+            xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
+            champ(:,1  ,il) = xppn
+            champ(:,jml,il) = xpps
+          END DO
+        ELSE
+          WRITE(lunout,*)'Could not compute potential temperature as the'
+          WRITE(lunout,*)'Exner function is missing or constant.'; STOP
+        END IF
+
+      CASE('q')                                            !--- Relat. humidity
+        IF(MINVAL(workvar)/=MAXVAL(workvar)) THEN
+          champ=0.01*champ*workvar
+          WHERE(champ<0.) champ=1.0E-10
+          DO il=1,lml
+            xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
+            xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
+            champ(:,1  ,il) = xppn
+            champ(:,jml,il) = xpps
+          END DO
+        ELSE
+          WRITE(lunout,*)'Could not compute specific humidity as the'
+          WRITE(lunout,*)'saturated humidity is missing or constant.'; STOP
+        END IF
+
+    END SELECT
+
+  END IF
+
+END SUBROUTINE startget_dyn
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in,masque_lu)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,                  INTENT(IN)           :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)           :: lat_in
+  REAL, DIMENSION(iml,jml), INTENT(IN), OPTIONAL :: masque_lu
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: orofname
+  LOGICAL               :: check=.TRUE.
+  REAL,    DIMENSION(1) :: lev
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: fid, llm_tmp, ttm_tmp
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: relief_hi, tmp_var
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+!-------------------------------------------------------------------------------
+  pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+
+  orofname = 'Relief.nc'; title='RELIEF'
+  IF(check) WRITE(lunout,*)'Reading the high resolution orography'
+  CALL flininfo(orofname, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
+
+  ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel))
+  CALL flinopen(orofname, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel,&
+                lev, ttm_tmp, itau, date, dt, fid)
+  ALLOCATE(relief_hi(iml_rel,jml_rel))
+  CALL flinget(fid, title, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi)
+  CALL flinclo(fid)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel))
+  lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad
+
+!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
+  ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel))
+  CALL conf_dat2d(title, iml_rel, jml_rel, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  relief_hi, .FALSE.)
+  DEALLOCATE(lon_ini,lat_ini)
+
+!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
+  IF(check) WRITE(lunout,*)'Computes all parameters needed for gravity wave dra&
+     &g code'
+
+  ALLOCATE(phis(iml,jml))      ! Geopotentiel au sol
+  ALLOCATE(zstd(iml,jml))      ! Deviation standard de l'orographie sous-maille
+  ALLOCATE(zsig(iml,jml))      ! Pente de l'orographie sous-maille 
+  ALLOCATE(zgam(iml,jml))      ! Anisotropie de l'orographie sous maille
+  ALLOCATE(zthe(iml,jml))      ! Orientation axe +grande pente d'oro sous maille
+  ALLOCATE(zpic(iml,jml))      ! Hauteur pics de la SSO
+  ALLOCATE(zval(iml,jml))      ! Hauteur vallees de la SSO
+  ALLOCATE(relief(iml,jml))    ! Orographie moyenne
+  ALLOCATE(masque(iml,jml))    ! Masque terre ocean
+  masque = -99999.
+  IF(PRESENT(masque_lu)) masque=masque_lu
+
+  CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, iml-1, jml,    &
+       lon_in, lat_in, phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
+  phis = phis * 9.81
+
+!--- SURFACE ROUGHNESS COMPUTATION (UNUSED FOR THE MOMENT !!! )
+  IF(check) WRITE(lunout,*)'Compute surface roughness induced by the orography'
+  ALLOCATE(rugo   (iml  ,jml))
+  ALLOCATE(tmp_var(iml-1,jml))
+  CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, iml-1, jml,      &
+       lon_in, lat_in, tmp_var)
+  rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
+  DEALLOCATE(relief_hi,tmp_var,lon_rad,lat_rad)
+  RETURN
+
+END SUBROUTINE start_init_orog
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,               INTENT(IN) :: iml, jml
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in
+  REAL, DIMENSION(jml),  INTENT(IN) :: lat_in
+  INTEGER,               INTENT(IN) :: jml2
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in2
+  REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2
+  LOGICAL,               INTENT(IN) :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: physfname
+  LOGICAL               :: check=.TRUE.
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: llm_tmp, ttm_tmp
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: var_ana
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL,    DIMENSION(:),   ALLOCATABLE :: levphys_ini
+!-------------------------------------------------------------------------------
+  physfname = 'ECPHY.nc'; pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+  IF(check) WRITE(lunout,*)'Opening the surface analysis'
+  CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)
+
+  ALLOCATE(lat_phys(iml_phys,jml_phys))
+  ALLOCATE(lon_phys(iml_phys,jml_phys))
+  ALLOCATE(levphys_ini(llm_tmp))
+  CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, llm_tmp, lon_phys,     &
+                lat_phys, levphys_ini, ttm_tmp, itau, date, dt, fid_phys)
+  DEALLOCATE(levphys_ini)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_phys),lat_ini(jml_phys))
+  lon_ini(:)=lon_phys(:,1); IF(MAXVAL(lon_phys)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_phys(1,:); IF(MAXVAL(lat_phys)>pi) lat_ini=lat_ini*deg2rad
+
+  ALLOCATE(var_ana(iml_phys,jml_phys),lon_rad(iml_phys),lat_rad(jml_phys))
+
+!--- SURFACE TEMPERATURE
+  title='ST'
+  ALLOCATE(tsol(iml,jml))
+  CALL flinget(fid_phys,title,iml_phys,jml_phys,llm_tmp,ttm_tmp,1,1,var_ana)
+  CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, lon_rad, lat_rad,&
+                  var_ana , ibar  )
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_phys, jml_phys, lon_rad, lat_rad, var_ana, iml, jml, jml-1,          &
+      lon_in,   lat_in,   lon_in2, lat_in2, tsol)
+
+!--- SOIL MOISTURE
+  title='CDSW'
+  ALLOCATE(qsol(iml,jml))
+  CALL flinget(fid_phys,title,iml_phys,jml_phys,llm_tmp,ttm_tmp,1,1,var_ana)
+  CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, lon_rad, lat_rad,&
+                  var_ana, ibar  )
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_phys, jml_phys, lon_rad, lat_rad, var_ana, iml, jml, jml-1,          &
+      lon_in,   lat_in,   lon_in2, lat_in2, qsol)
+
+  CALL flinclo(fid_phys)
+
+  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
+
+END SUBROUTINE start_init_phys
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_dyn(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,               INTENT(IN) :: iml, jml
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in
+  REAL, DIMENSION(jml),  INTENT(IN) :: lat_in
+  INTEGER,               INTENT(IN) :: jml2
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in2
+  REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2
+  LOGICAL,               INTENT(IN) :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: physfname
+  LOGICAL               :: check=.TRUE.
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: i, j
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: var_ana, z
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL,    DIMENSION(:),   ALLOCATABLE :: xppn, xpps
+!-------------------------------------------------------------------------------
+
+!--- KINETIC ENERGY
+  physfname = 'ECDYN.nc'; pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+  IF(check) WRITE(lunout,*) 'Opening the surface analysis'
+  CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
+  IF(check) WRITE(lunout,*) 'Values read: ', iml_dyn, jml_dyn, llm_dyn, ttm_dyn
+
+  ALLOCATE(lat_dyn(iml_dyn,jml_dyn))
+  ALLOCATE(lon_dyn(iml_dyn,jml_dyn))
+  ALLOCATE(levdyn_ini(llm_dyn))
+  CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn, lon_dyn,lat_dyn,&
+                levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_dyn),lat_ini(jml_dyn))
+  lon_ini(:)=lon_dyn(:,1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_dyn(1,:); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
+
+  ALLOCATE(var_ana(iml_dyn,jml_dyn),lon_rad(iml_dyn),lat_rad(jml_dyn))
+
+!--- SURFACE GEOPOTENTIAL
+  title='Z'
+  ALLOCATE(z(iml,jml))
+  CALL flinget(fid_dyn, title, iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
+  CALL conf_dat2d(title, iml_dyn, jml_dyn, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  var_ana, ibar)
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_dyn, jml_dyn, lon_rad, lat_rad, var_ana, iml, jml, jml-1,            &
+      lon_in,  lat_in,  lon_in2, lat_in2, z)
+
+!--- SURFACE PRESSURE
+  title='SP'
+  ALLOCATE(psol_dyn(iml,jml))
+  CALL flinget(fid_dyn, title, iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
+  CALL conf_dat2d(title, iml_dyn, jml_dyn, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  var_ana, ibar)
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_dyn, jml_dyn, lon_rad, lat_rad, var_ana, iml, jml, jml-1,            &
+      lon_in,  lat_in,  lon_in2, lat_in2, psol_dyn)
+
+  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
+
+!--- ALLOCATION OF VARIABLES CREATED IN OR COMING FROM RESTART FILE
+  IF(.NOT.ALLOCATED(tsol)) THEN
+    CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+  ELSE
+    IF(SIZE(tsol)/=SIZE(psol_dyn)) THEN
+      WRITE(lunout,*)'start_init_dyn :'
+      WRITE(lunout,*)'The temperature field we have does not have the right size'
+      STOP
+    END IF
+  END IF
+
+  IF(.NOT.ALLOCATED(phis)) THEN
+    CALL start_init_orog(iml,jml,lon_in,lat_in)
+  ELSE
+    IF(SIZE(phis)/=SIZE(psol_dyn)) THEN
+      WRITE(lunout,*)'start_init_dyn :'
+      WRITE(lunout,*)'The orography field we have does not have the right size'
+      STOP
+    END IF
+  END IF
+
+!--- PSOL IS COMPUTED IN PASCALS
+  DO j = 1, jml
+    DO i = 1, iml-1
+      psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j))/287.0/tsol(i,j))
+    END DO
+    psol_dyn(iml,j) = psol_dyn(1,j)
+  END DO
+  DEALLOCATE(z)
+
+  ALLOCATE(xppn(iml-1),xpps(iml-1)) 
+  DO i = 1, iml-1
+    xppn(i) = aire( i,1) * psol_dyn( i,1)
+    xpps(i) = aire( i,jml) * psol_dyn( i,jml)
+  END DO
+  DO i = 1, iml
+    psol_dyn(i,1  ) = SUM(xppn)/apoln
+    psol_dyn(i,jml) = SUM(xpps)/apols
+  END DO
+  DEALLOCATE(xppn,xpps) 
+
+  RETURN
+
+END SUBROUTINE start_init_dyn
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in, lat_in, jml2, &
+     lon_in2, lat_in2, pls_in, var3d, ibar)
+
+  use pchsp_95_m, only: pchsp_95
+  use pchfe_95_m, only: pchfe_95
+
+! Arguments:
+  CHARACTER(LEN=*),             INTENT(IN)    :: varname
+  INTEGER,                      INTENT(IN)    :: iml, jml, lml
+  REAL, DIMENSION(iml),         INTENT(IN)    :: lon_in
+  REAL, DIMENSION(jml),         INTENT(IN)    :: lat_in
+  INTEGER,                      INTENT(IN)    :: jml2
+  REAL, DIMENSION(iml),         INTENT(IN)    :: lon_in2
+  REAL, DIMENSION(jml2),        INTENT(IN)    :: lat_in2
+  REAL, DIMENSION(iml, jml, lml), INTENT(IN)    :: pls_in
+  REAL, DIMENSION(iml, jml, lml), INTENT(OUT)   :: var3d
+  LOGICAL,                      INTENT(IN)    :: ibar
+!----------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  LOGICAL:: check=.TRUE., skip
+  REAL                  chmin, chmax
+  INTEGER ii, ij, il, ierr
+  integer n_extrap ! number of extrapolated points
+  REAL, DIMENSION(iml, jml, llm_dyn):: var_tmp3d
+  REAL,    DIMENSION(:),     ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL, DIMENSION(llm_dyn):: lev_dyn, ax, ay, yder
+
+!---------------------------------------------------------------------------
+  IF(check) WRITE(lunout, *)'Going into flinget to extract the 3D  field.'
+  IF(check) WRITE(lunout, *) fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, &
+       ttm_dyn
+  IF(check) WRITE(lunout, *) 'Allocating space for interpolation', iml, jml, &
+       llm_dyn
+
+  IF(.NOT.ALLOCATED(var_ana3d)) ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
+  CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
+       var_ana3d)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_dyn), lat_ini(jml_dyn))
+  lon_ini(:)=lon_dyn(:, 1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_dyn(1, :); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
+
+!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
+  ALLOCATE(lon_rad(iml_dyn), lat_rad(jml_dyn))
+  CALL conf_dat3d (varname, iml_dyn, jml_dyn, llm_dyn, lon_ini, lat_ini,      &
+                   levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d, ibar)
+  DEALLOCATE(lon_ini, lat_ini)
+
+!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
+  DO il=1, llm_dyn
+    CALL interp_startvar(varname, ibar, il==1, iml_dyn, jml_dyn, lon_rad, &
+         lat_rad, var_ana3d(:, :, il), iml, jml, jml2, lon_in, lat_in, &
+         lon_in2, lat_in2, var_tmp3d(:, :, il))
+  END DO
+  DEALLOCATE(lon_rad, lat_rad)
+
+!--- VERTICAL INTERPOLATION IS PERFORMED FROM TOP OF ATMOSPHERE TO GROUND
+  ax = lev_dyn(llm_dyn:1:-1) 
+  skip = .false.
+  n_extrap = 0
+  DO ij=1, jml
+    DO ii=1, iml-1
+      ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
+      yder = pchsp_95(ax, ay, ibeg=2, iend=2, vc_beg=0., vc_end=0.)
+      CALL pchfe_95(ax, ay, yder, skip, pls_in(ii, ij, lml:1:-1), &
+           var3d(ii, ij, lml:1:-1), ierr)
+      if (ierr < 0) stop 1
+      n_extrap = n_extrap + ierr
+    END DO
+  END DO
+  if (n_extrap /= 0) then
+     print *, "start_inter_3d pchfe_95: n_extrap = ", n_extrap
+  end if
+  var3d(iml, :, :) = var3d(1, :, :) 
+
+  DO il=1, lml
+    CALL minmax(iml*jml, var3d(1, 1, il), chmin, chmax)
+    WRITE(lunout, *)' '//TRIM(varname)//'  min max l ', il, chmin, chmax
+  END DO
+
+END SUBROUTINE start_inter_3d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE interp_startvar(vname, ibar, ibeg, ii, jj,    lon,  lat,  vari,     &
+                                 i1, j1, j2, lon1, lat1, lon2, lat2, varo)
+!
+!-------------------------------------------------------------------------------
+
+  USE inter_barxy_m, only: inter_barxy
+
+! Arguments:
+  CHARACTER(LEN=*),       INTENT(IN)  :: vname
+  LOGICAL,                INTENT(IN)  :: ibar, ibeg
+  INTEGER,                INTENT(IN)  :: ii, jj
+  REAL, DIMENSION(ii),    INTENT(IN)  :: lon
+  REAL, DIMENSION(jj),    INTENT(IN)  :: lat
+  REAL, DIMENSION(ii,jj), INTENT(IN)  :: vari
+  INTEGER,                INTENT(IN)  :: i1, j1, j2
+  REAL, DIMENSION(i1),    INTENT(IN)  :: lon1
+  REAL, DIMENSION(j1),    INTENT(IN)  :: lat1
+  REAL, DIMENSION(i1),    INTENT(IN)  :: lon2
+  REAL, DIMENSION(j2),    INTENT(IN)  :: lat2
+  REAL, DIMENSION(i1,j1), INTENT(OUT) :: varo
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(i1-1,j1) :: vtmp
+!-------------------------------------------------------------------------------
+  IF(ibar) THEN
+    IF(ibeg) THEN
+      WRITE(lunout,*)                                                          &
+               '---------------------------------------------------------------'
+      WRITE(lunout,*)                                                          &
+ '$$$ Utilisation de l interpolation barycentrique  pour  '//TRIM(vname)//' $$$'
+      WRITE(lunout,*)                                                          &
+               '---------------------------------------------------------------'
+    END IF
+    CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2(:j2), vtmp)
+  ELSE
+    CALL grille_m   (ii, jj,   lon, lat, vari, i1-1, j1, lon1, lat1,     vtmp)
+  END IF
+  CALL gr_int_dyn(vtmp, varo, i1-1, j1)
+
+END SUBROUTINE interp_startvar
+!
+!-------------------------------------------------------------------------------
+
+#endif
+! of #ifdef CPP_EARTH
+
+END MODULE startvar
+!
+!*******************************************************************************
Index: LMDZ5/trunk/libf/dyn3dmem/top_bound_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/top_bound_p.F	(revision 1657)
+++ 	(revision )
@@ -1,161 +1,0 @@
-      SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh )
-      USE parallel
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-
-
-c ..  DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO,
-C     F. LOTT DEC. 2006
-c                                 (  10/12/06  )
-
-c=======================================================================
-c
-c   Auteur:  F. LOTT  
-c   -------
-c
-c   Objet:
-c   ------
-c
-c   Dissipation linéaire (ex top_bound de la physique)
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "comdissipn.h"
-
-c   Arguments:
-c   ----------
-
-      REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
-      REAL masse(iip1,jjp1,llm)
-      REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
-
-c   Local:
-c   ------
-      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
-      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
-      
-      INTEGER NDAMP
-      PARAMETER (NDAMP=4)
-      integer i	
-      REAL,SAVE :: rdamp(llm)
-!     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/) 
-      LOGICAL,SAVE :: first=.true.
-      INTEGER j,l,jjb,jje
-
-
-      if (iflag_top_bound == 0) return
-      if (first) then
-c$OMP BARRIER
-c$OMP MASTER
-         if (iflag_top_bound == 1) then
-! couche eponge dans les 4 dernieres couches du modele
-             rdamp(:)=0.
-             rdamp(llm)=tau_top_bound
-             rdamp(llm-1)=tau_top_bound/2.
-             rdamp(llm-2)=tau_top_bound/4.
-             rdamp(llm-3)=tau_top_bound/8.
-         else if (iflag_top_bound == 2) then
-! couce eponge dans toutes les couches de pression plus faible que
-! 100 fois la pression de la derniere couche
-             rdamp(:)=tau_top_bound
-     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
-         endif
-         first=.false.
-         print*,'TOP_BOUND rdamp=',rdamp
-c$OMP END MASTER
-c$OMP BARRIER
-      endif
-
-
-      CALL massbar_p(masse,massebx,masseby)
-C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
-
-      jjb=jj_begin
-      jje=jj_end
-      IF (pole_sud) jje=jj_end-1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      do l=1,llm
-        do j=jjb,jje
-          zm=0.
-          vzon(j,l)=0
-          do i=1,iim
-! Rm: on peut travailler directement avec la moyenne zonale de vcov
-! plutot qu'avec celle de v car le coefficient cv qui relie les deux
-! ne varie qu'en latitude
-            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
-            zm=zm+masseby(i,j,l)
-          enddo
-          vzon(j,l)=vzon(j,l)/zm
-        enddo
-      enddo
-c$OMP END DO NOWAIT   
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      do l=1,llm
-        do j=jjb,jje
-          do i=1,iip1
-            dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
-          enddo
-        enddo
-      enddo
-c$OMP END DO NOWAIT
-
-      jjb=jj_begin
-      jje=jj_end
-      IF (pole_nord) jjb=jj_begin+1
-      IF (pole_sud)  jje=jj_end-1
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      do l=1,llm
-        do j=jjb,jje
-          uzon(j,l)=0.
-          zm=0.
-          do i=1,iim
-            uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
-            zm=zm+massebx(i,j,l)
-          enddo
-          uzon(j,l)=uzon(j,l)/zm
-        enddo
-      enddo
-c$OMP END DO NOWAIT
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
-      do l=1,llm
-        do j=jjb,jje
-          zm=0.
-          tzon(j,l)=0.
-          do i=1,iim
-            tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
-            zm=zm+masse(i,j,l)
-          enddo
-          tzon(j,l)=tzon(j,l)/zm
-        enddo
-      enddo
-c$OMP END DO NOWAIT
-
-C   AMORTISSEMENTS LINEAIRES:
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
-      do l=1,llm
-        do j=jjb,jje
-          do i=1,iip1
-            du(i,j,l)=du(i,j,l)
-     s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
-            dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
-          enddo
-       enddo
-      enddo
-c$OMP END DO NOWAIT
-      
-
-      RETURN
-      END
Index: LMDZ5/trunk/libf/dyn3dmem/traceurpole.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/traceurpole.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/traceurpole.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: traceurpole.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: traceurpole.F 1403 2010-07-01 09:02:53Z fairhead $
 !
           subroutine traceurpole(q,masse)
Index: LMDZ5/trunk/libf/dyn3dmem/ugeostr.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/ugeostr.F	(revision 1657)
+++ LMDZ5/trunk/libf/dyn3dmem/ugeostr.F	(revision 1658)
@@ -1,4 +1,4 @@
 !
-! $Id: ugeostr.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id: ugeostr.F 1403 2010-07-01 09:02:53Z fairhead $
 !
       subroutine ugeostr(phi,ucov)
Index: LMDZ5/trunk/libf/dyn3dmem/writedynav_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/writedynav_p.F	(revision 1657)
+++ 	(revision )
@@ -1,169 +1,0 @@
-!
-! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-      subroutine writedynav_p( histid, time, vcov, 
-     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-      USE ioipsl
-#endif
-      USE parallel
-      USE misc_mod
-      USE infotrac
-      implicit none
-
-C
-C   Ecriture du fichier histoire au format IOIPSL
-C
-C   Appels succesifs des routines: histwrite
-C
-C   Entree:
-C      histid: ID du fichier histoire
-C      time: temps de l'ecriture
-C      vcov: vents v covariants
-C      ucov: vents u covariants
-C      teta: temperature potentielle
-C      phi : geopotentiel instantane
-C      q   : traceurs
-C      masse: masse
-C      ps   :pression au sol
-C      phis : geopotentiel au sol
-C      
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
-
-C
-C   Arguments
-C
-
-      INTEGER histid
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)                  
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL phis(ip1jmp1)                  
-      REAL q(ip1jmp1,llm,nqtot)
-      integer time
-
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-C   Variables locales
-C
-      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
-      real us(ip1jmp1,llm), vs(ip1jmp1,llm)
-      real tm(ip1jmp1,llm)
-      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
-      logical ok_sync
-      integer itau_w
-      integer :: ijb,ije,jjn
-C
-C  Initialisations
-C
-      if (adjust) return
-      
-      ndex3d = 0
-      ndex2d = 0
-      ok_sync = .TRUE.
-      us = 999.999
-      vs = 999.999
-      tm = 999.999
-      vnat = 999.999
-      unat = 999.999
-      itau_w = itau_dyn + time
-
-C Passage aux composantes naturelles du vent
-      call covnat_p(llm, ucov, vcov, unat, vnat)
-
-C
-C  Appels a histwrite pour l'ecriture des variables a sauvegarder
-C
-C  Vents U scalaire
-C
-      call gr_u_scal_p(llm, unat, us)
-      
-      ijb=ij_begin
-      ije=ij_end
-      jjn=jj_nb
-      
-      call histwrite(histid, 'u', itau_w, us(ijb:ije,:), 
-     .               iip1*jjn*llm, ndex3d)
-C
-C  Vents V scalaire
-C
-      
-      call gr_v_scal_p(llm, vnat, vs)
-      call histwrite(histid, 'v', itau_w, vs(ijb:ije,:), 
-     .               iip1*jjn*llm, ndex3d)
-C
-C  Temperature potentielle moyennee
-C
-     
-      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:), 
-     .                iip1*jjn*llm, ndex3d)
-C
-C  Temperature moyennee
-C
-      do ll=1,llm
-        do ii = ijb, ije
-          tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
-        enddo
-      enddo
-      
-      call histwrite(histid, 'temp', itau_w, tm(ijb:ije,:), 
-     .                iip1*jjn*llm, ndex3d)
-C
-C  Geopotentiel
-C
-      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:), 
-     .                iip1*jjn*llm, ndex3d)
-C
-C  Traceurs
-C
-        DO iq=1,nqtot
-          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq), 
-     .                   iip1*jjn*llm, ndex3d)
-        enddo
-C
-C  Masse
-C
-       call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
-     .                iip1*jjn, ndex2d)
-C
-C  Pression au sol
-C
-       call histwrite(histid, 'ps', itau_w, ps(ijb:ije), 
-     .                 iip1*jjn, ndex2d)
-C
-C  Geopotentiel au sol
-C
-       call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
-     .                 iip1*jjn, ndex2d)
-C
-C  Fin
-C
-      if (ok_sync) call histsync(histid)
-#else
-      write(lunout,*)'writedynav_p: Needs IOIPSL to function'
-#endif
-! #endif of #ifdef CPP_IOIPSL
-      return
-      end
Index: LMDZ5/trunk/libf/dyn3dmem/writehist_p.F
===================================================================
--- LMDZ5/trunk/libf/dyn3dmem/writehist_p.F	(revision 1657)
+++ 	(revision )
@@ -1,156 +1,0 @@
-!
-! $Id: writehist_p.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-      subroutine writehist_p( histid, histvid, time, vcov, 
-     ,                          ucov,teta,phi,q,masse,ps,phis)
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-      USE ioipsl
-#endif
-      USE parallel
-      USE misc_mod
-      USE infotrac
-      implicit none
-
-C
-C   Ecriture du fichier histoire au format IOIPSL
-C
-C   Appels succesifs des routines: histwrite
-C
-C   Entree:
-C      histid: ID du fichier histoire
-C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
-C      time: temps de l'ecriture
-C      vcov: vents v covariants
-C      ucov: vents u covariants
-C      teta: temperature potentielle
-C      phi : geopotentiel instantane
-C      q   : traceurs
-C      masse: masse
-C      ps   :pression au sol
-C      phis : geopotentiel au sol
-C      
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
-
-C
-C   Arguments
-C
-
-      INTEGER histid, histvid
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL phis(ip1jmp1)                  
-      REAL q(ip1jmp1,llm,nqtot)
-      integer time
-
-#ifdef CPP_IOIPSL
-! This routine needs IOIPSL
-C   Variables locales
-C
-      integer iq, ii, ll
-      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
-      logical ok_sync
-      integer itau_w
-      integer :: ijb,ije,jjn
-C
-C  Initialisations
-C
-      if (adjust) return
-     
-    
-      ndexu = 0
-      ndexv = 0
-      ndex2d = 0
-      ok_sync =.TRUE.
-      itau_w = itau_dyn + time
-C
-C  Appels a histwrite pour l'ecriture des variables a sauvegarder
-C
-C  Vents U
-C
-      ijb=ij_begin
-      ije=ij_end
-      jjn=jj_nb
-          
-      call histwrite(histid, 'ucov', itau_w, ucov(ijb:ije,:), 
-     .               iip1*jjn*llm, ndexu)
-
-C
-C  Vents V
-C
-      if (pole_sud) ije=ij_end-iip1
-      if (pole_sud) jjn=jj_nb-1
-      
-      call histwrite(histvid, 'vcov', itau_w, vcov(ijb:ije,:), 
-     .               iip1*jjn*llm, ndexv)
-
-C
-C  Temperature potentielle
-C
-      ijb=ij_begin
-      ije=ij_end
-      jjn=jj_nb
-
-      call histwrite(histid, 'teta', itau_w, teta(ijb:ije,:), 
-     .                iip1*jjn*llm, ndexu)
-C
-C  Geopotentiel
-C
-      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:), 
-     .                iip1*jjn*llm, ndexu)
-C
-C  Traceurs
-C
-        DO iq=1,nqtot
-          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq), 
-     .                   iip1*jjn*llm, ndexu)
-        enddo
-C
-C  Masse
-C
-      call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
-     .               iip1*jjn, ndex2d)
-C
-C  Pression au sol
-C
-      call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
-     .               iip1*jjn, ndex2d)
-C
-C  Geopotentiel au sol
-C
-      call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
-     .               iip1*jjn, ndex2d)
-C
-C  Fin
-C
-      if (ok_sync) then
-        call histsync(histid)
-        call histsync(histvid)
-      endif
-#else
-      write(lunout,*)'writehist_p: Needs IOIPSL to function'
-#endif
-! #endif of #ifdef CPP_IOIPSL
-      return
-      end
