Index: LMDZ5/branches/testing/libf/dyn3dmem/PVtheta.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/PVtheta.F	(revision 1910)
+++ 	(revision )
@@ -1,196 +1,0 @@
-      SUBROUTINE PVtheta(ilon,ilev,pucov,pvcov,pteta,
-     $           ztfi,zplay,zplev,
-     $           nbteta,theta,PVteta)
-      IMPLICIT none
-
-c=======================================================================
-c
-c   Auteur:  I. Musat
-c   -------
-c
-c   Objet:
-c   ------
-c
-c    *******************************************************************
-c    Calcul de la vorticite potentielle PVteta sur des iso-theta selon
-c    la methodologie du NCEP/NCAR :
-c    1) on calcule la stabilite statique N**2=g/T*(dT/dz+g/cp) sur les
-c       niveaux du modele => N2
-c    2) on interpole les vents, la temperature et le N**2 sur des isentropes
-c       (en fait sur des iso-theta) lineairement en log(theta) =>
-c       ucovteta, vcovteta, N2teta
-c    3) on calcule la vorticite absolue sur des iso-theta => vorateta
-c    4) on calcule la densite rho sur des iso-theta => rhoteta 
-c
-c       rhoteta = (T/theta)**(cp/R)*p0/(R*T)
-c
-c    5) on calcule la vorticite potentielle sur des iso-theta => PVteta
-c
-c       PVteta = (vorateta * N2 * theta)/(g * rhoteta) ! en PVU
-c
-c       NB: 1PVU=10**(-6) K*m**2/(s * kg)
-c
-c       PVteta =  vorateta * N2/(g**2 * rhoteta) ! en 1/(Pa*s)
-c
-c
-c    *******************************************************************
-c
-c
-c     Variables d'entree : ilon,ilev,pucov,pvcov,pteta,ztfi,zplay,zplev,nbteta,theta
-c                       -> sur la grille dynamique
-c     Variable de sortie : PVteta
-c                       -> sur la grille physique 
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-c
-c variables Input
-c
-      INTEGER ilon, ilev
-      REAL pvcov(iip1,jjm,ilev)
-      REAL pucov(iip1,jjp1,ilev)
-      REAL pteta(iip1,jjp1,ilev)
-      REAL ztfi(ilon,ilev)
-      REAL zplay(ilon,ilev), zplev(ilon,ilev+1)
-      INTEGER nbteta
-      REAL theta(nbteta)
-c
-c variable Output
-c
-      REAL PVteta(ilon,nbteta)
-c
-c variables locales
-c
-      INTEGER i, j, l, ig0
-      REAL SSUM
-      REAL teta(ilon, ilev)
-      REAL ptetau(ip1jmp1, ilev), ptetav(ip1jm, ilev)
-      REAL ucovteta(ip1jmp1,ilev), vcovteta(ip1jm,ilev)
-      REAL N2(ilon,ilev-1), N2teta(ilon,nbteta)
-      REAL ztfiteta(ilon,nbteta)
-      REAL rhoteta(ilon,nbteta)
-      REAL vorateta(iip1,jjm,nbteta)
-      REAL voratetafi(ilon,nbteta), vorpol(iim)
-c
-#include "comgeom2.h"
-#include "comconst.h"
-#include "comvert.h"
-c
-c projection teta sur la grille physique
-c
-      DO l=1,llm
-       teta(1,l)   =  pteta(1,1,l)
-       ig0         = 2
-       DO j = 2, jjm
-        DO i = 1, iim
-         teta(ig0,l)    = pteta(i,j,l)
-         ig0            = ig0 + 1
-        ENDDO
-       ENDDO
-       teta(ig0,l)    = pteta(1,jjp1,l)
-      ENDDO
-c
-c calcul pteta sur les grilles U et V
-c
-      DO l=1, llm
-       DO j=1, jjp1
-        DO i=1, iip1
-         ig0=i+(j-1)*iip1
-         ptetau(ig0,l)=pteta(i,j,l)
-        ENDDO !i
-       ENDDO !j
-       DO j=1, jjm
-        DO i=1, iip1
-         ig0=i+(j-1)*iip1
-         ptetav(ig0,l)=0.5*(pteta(i,j,l)+pteta(i,j+1,l))
-        ENDDO !i
-       ENDDO !j
-      ENDDO !l
-c
-c projection pucov, pvcov sur une surface de theta constante
-c
-      DO l=1, nbteta
-cIM 1rout CALL tetaleveli1j1(ip1jmp1,llm,.true.,ptetau,theta(l),
-       CALL tetalevel(ip1jmp1,llm,.true.,ptetau,theta(l),
-     .                pucov,ucovteta(:,l))
-cIM 1rout CALL tetaleveli1j(ip1jm,llm,.true.,ptetav,theta(l),
-       CALL tetalevel(ip1jm,llm,.true.,ptetav,theta(l),
-     .                pvcov,vcovteta(:,l))
-      ENDDO !l
-c
-c calcul vorticite absolue sur une iso-theta : vorateta
-c
-      CALL tourabs(nbteta,vcovteta,ucovteta,vorateta)
-c
-c projection vorateta sur la grille physique => voratetafi
-c
-      DO l=1,nbteta
-       DO j=2,jjm
-        ig0=1+(j-2)*iim
-        DO i=1,iim
-         voratetafi(ig0+i+1,l) = vorateta( i ,j-1,l) * alpha4(i+1,j) +
-     $                           vorateta(i+1,j-1,l) * alpha1(i+1,j) +
-     $                           vorateta(i  ,j  ,l) * alpha3(i+1,j) +
-     $                           vorateta(i+1,j  ,l) * alpha2(i+1,j)
-        ENDDO
-        voratetafi(ig0 +1,l) = voratetafi(ig0 +1+ iim,l)
-       ENDDO
-      ENDDO
-c
-      DO l=1,nbteta
-       DO i=1,iim
-        vorpol(i)  = vorateta(i,1,l)*aire(i,1)
-       ENDDO
-       voratetafi(1,l)= SSUM(iim,vorpol,1)/apoln
-      ENDDO
-c
-      DO l=1,nbteta
-       DO i=1,iim
-        vorpol(i)  = vorateta(i,jjm,l)* aire(i,jjm +1)
-       ENDDO
-       voratetafi(ilon,l)= SSUM(iim,vorpol,1)/apols
-      ENDDO
-c 
-c calcul N**2 sur la grille physique => N2
-c
-      DO l=1, llm-1 
-       DO i=1, ilon
-        N2(i,l) = (g**2 * zplay(i,l) * 
-     $            (ztfi(i,l+1)-ztfi(i,l)) )/
-     $            (R*ztfi(i,l)*ztfi(i,l)*
-     $            (zplev(i,l)-zplev(i,l+1)) )+
-     $            (g**2)/(ztfi(i,l)*CPP)
-       ENDDO !i
-      ENDDO !l
-c
-c calcul N2 sur une iso-theta => N2teta 
-c
-      DO l=1, nbteta
-       CALL tetalevel(ilon,llm-1,.true.,teta,theta(l),
-     $                N2,N2teta(:,l))
-       CALL tetalevel(ilon,llm,.true.,teta,theta(l),
-     $                ztfi,ztfiteta(:,l))
-      ENDDO !l=1, nbteta
-c
-c calcul rho et PV sur une iso-theta : rhoteta, PVteta
-c
-      DO l=1, nbteta
-       DO i=1, ilon
-        rhoteta(i,l)=(ztfiteta(i,l)/theta(l))**(CPP/R)*
-     $  (preff/(R*ztfiteta(i,l)))
-c
-c PVteta en PVU
-c
-        PVteta(i,l)=(theta(l)*g*voratetafi(i,l)*N2teta(i,l))/
-     $              (g**2*rhoteta(i,l))
-c
-c PVteta en 1/(Pa*s)
-c
-        PVteta(i,l)=(voratetafi(i,l)*N2teta(i,l))/
-     $              (g**2*rhoteta(i,l))
-       ENDDO !i
-      ENDDO !l
-c
-      RETURN
-      END 
Index: LMDZ5/branches/testing/libf/dyn3dmem/academic.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/academic.h	(revision 1910)
+++ 	(revision )
@@ -1,9 +1,0 @@
-!
-! $Id$
-!
-      common/academic/tetarappel,knewt_t,kfrict,knewt_g,clat4
-      real :: tetarappel(ip1jmp1,llm)
-      real :: knewt_t(llm)
-      real :: kfrict(llm)
-      real :: knewt_g
-      real :: clat4(ip1jmp1)
Index: LMDZ5/branches/testing/libf/dyn3dmem/adaptdt.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/adaptdt.F	(revision 1910)
+++ 	(revision )
@@ -1,60 +1,0 @@
-!
-! $Id: adaptdt.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      subroutine adaptdt(nadv,dtbon,n,pbaru,
-     c                   masse)
-
-      USE control_mod
-
-      IMPLICIT NONE
-
-#include "dimensions.h"
-c#include "paramr2.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-#include "ener.h"
-#include "description.h"
-
-c----------------------------------------------------------
-c     Arguments
-c----------------------------------------------------------
-      INTEGER n,nadv
-      REAL dtbon 
-      REAL pbaru(iip1,jjp1,llm)
-      REAL masse(iip1,jjp1,llm)
-c----------------------------------------------------------    
-c     Local
-c----------------------------------------------------------
-      INTEGER i,j,l
-      REAL CFLmax,aaa,bbb
-      
-        CFLmax=0.
-        do l=1,llm
-         do j=2,jjm
-          do i=1,iim
-             aaa=pbaru(i,j,l)*dtvr/masse(i,j,l)
-             CFLmax=max(CFLmax,aaa)
-             bbb=-pbaru(i,j,l)*dtvr/masse(i+1,j,l)
-             CFLmax=max(CFLmax,bbb)
-          enddo
-         enddo
-        enddo              
-        n=int(CFLmax)+1
-c pour reproduire cas VL du code qui appele x,y,z,y,x
-c        if (nadv.eq.30) n=n/2   ! Pour Prather
-        dtbon=dtvr/n
-        
-       return
-       end
-
-
-
-
-
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/addfi_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/addfi_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/addfi_loc.F	(revision 1999)
@@ -55,15 +55,19 @@
 c    -----------
 c
-      REAL pdt
-c
-      REAL pvcov(ijb_v:ije_v,llm),pucov(ijb_u:ije_u,llm)
-      REAL pteta(ijb_u:ije_u,llm),pq(ijb_u:ije_u,llm,nqtot)
-      REAL pps(ijb_u:ije_u)
-c
-      REAL pdvfi(ijb_v:ije_v,llm),pdufi(ijb_u:ije_u,llm)
-      REAL pdqfi(ijb_u:ije_u,llm,nqtot),pdhfi(ijb_u:ije_u,llm)
-      REAL pdpfi(ijb_u:ije_u)
-c
-      LOGICAL leapf,forward
+      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
+c
+      REAL,INTENT(INOUT) :: pvcov(ijb_v:ije_v,llm) ! covariant meridional wind
+      REAL,INTENT(INOUT) :: pucov(ijb_u:ije_u,llm) ! covariant zonal wind
+      REAL,INTENT(INOUT) :: pteta(ijb_u:ije_u,llm) ! potential temperature
+      REAL,INTENT(INOUT) :: pq(ijb_u:ije_u,llm,nqtot) ! tracers
+      REAL,INTENT(INOUT) :: pps(ijb_u:ije_u) ! surface pressure (Pa)
+c respective tendencies (.../s) to add
+      REAL,INTENT(IN) :: pdvfi(ijb_v:ije_v,llm)
+      REAL,INTENT(IN) :: pdufi(ijb_u:ije_u,llm)
+      REAL,INTENT(IN) :: pdqfi(ijb_u:ije_u,llm,nqtot)
+      REAL,INTENT(IN) :: pdhfi(ijb_u:ije_u,llm)
+      REAL,INTENT(IN) :: pdpfi(ijb_u:ije_u)
+c
+      LOGICAL,INTENT(IN) :: leapf,forward ! not used
 c
 c
@@ -73,7 +77,6 @@
       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,PARAMETER :: qtestw = 1.0e-15
+      REAL,PARAMETER :: qtestt = 1.0e-40
 
       REAL SSUM
Index: LMDZ5/branches/testing/libf/dyn3dmem/advn.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advn.F	(revision 1910)
+++ 	(revision )
@@ -1,983 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE advn(q,masse,w,pbaru,pbarv,pdt,mode)
-c
-c     Auteur : F. Hourdin
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
-c
-c   pbaru,pbarv,w flux de masse en u ,v ,w
-c   pdt pas de temps
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "iniprint.h"
-
-c
-c   Arguments:
-c   ----------
-      integer mode
-      real masse(ip1jmp1,llm)
-      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
-      REAL q(ip1jmp1,llm)
-      REAL w(ip1jmp1,llm),pdt
-c
-c      Local 
-c   ---------
-c
-      INTEGER i,ij,l,j,ii
-      integer ijlqmin,iqmin,jqmin,lqmin
-      integer ismin
-c
-      real zm(ip1jmp1,llm),newmasse
-      real mu(ip1jmp1,llm)
-      real mv(ip1jm,llm)
-      real mw(ip1jmp1,llm+1)
-      real zq(ip1jmp1,llm),zz,qpn,qps
-      real zqg(ip1jmp1,llm),zqd(ip1jmp1,llm)
-      real zqs(ip1jmp1,llm),zqn(ip1jmp1,llm)
-      real zqh(ip1jmp1,llm),zqb(ip1jmp1,llm)
-      real temps0,temps1,temps2,temps3
-      real ztemps1,ztemps2,ztemps3,ssum
-      logical testcpu
-      save testcpu
-      save temps1,temps2,temps3
-      real zzpbar,zzw
-
-#ifdef CRAY
-      real second
-#endif
-
-      real qmin,qmax
-      data qmin,qmax/0.,1./
-      data testcpu/.false./
-      data temps1,temps2,temps3/0.,0.,0./
-
-      zzpbar = 0.5 * pdt
-      zzw    = pdt
-
-      DO l=1,llm
-        DO ij = iip2,ip1jm
-            mu(ij,l)=pbaru(ij,l) * zzpbar
-         ENDDO
-         DO ij=1,ip1jm
-            mv(ij,l)=pbarv(ij,l) * zzpbar
-         ENDDO
-         DO ij=1,ip1jmp1
-            mw(ij,l)=w(ij,l) * zzw
-         ENDDO
-      ENDDO
-
-      DO ij=1,ip1jmp1
-         mw(ij,llm+1)=0.
-      ENDDO
-
-      do l=1,llm
-         qpn=0.
-         qps=0.
-         do ij=1,iim
-            qpn=qpn+q(ij,l)*masse(ij,l)
-            qps=qps+q(ip1jm+ij,l)*masse(ip1jm+ij,l)
-         enddo
-         qpn=qpn/ssum(iim,masse(1,l),1)
-         qps=qps/ssum(iim,masse(ip1jm+1,l),1)
-         do ij=1,iip1
-            q(ij,l)=qpn
-            q(ip1jm+ij,l)=qps
-         enddo
-      enddo
-
-      do ij=1,ip1jmp1
-         mw(ij,llm+1)=0.
-      enddo
-      do l=1,llm
-         do ij=1,ip1jmp1
-            zq(ij,l)=q(ij,l)
-            zm(ij,l)=masse(ij,l)
-         enddo
-      enddo
-
-c     call minmaxq(zq,qmin,qmax,'avant vlx     ')
-      call advnqx(zq,zqg,zqd)
-      call advnx(zq,zqg,zqd,zm,mu,mode)
-      call advnqy(zq,zqs,zqn)
-      call advny(zq,zqs,zqn,zm,mv)
-      call advnqz(zq,zqh,zqb)
-      call advnz(zq,zqh,zqb,zm,mw)
-c     call vlz(zq,0.,zm,mw)
-      call advnqy(zq,zqs,zqn)
-      call advny(zq,zqs,zqn,zm,mv)
-      call advnqx(zq,zqg,zqd)
-      call advnx(zq,zqg,zqd,zm,mu,mode)
-c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
-
-#ifdef CRAY
-      if(testcpu) then
-         ztemps1=second(0.)
-         temps1=temps1+ztemps1-ztemps2
-            print*,'VLSPLT X:',temps1,'   Y:',temps2,'   Z:',temps3
-      endif
-#endif
-      do l=1,llm
-         do ij=1,ip1jmp1
-           q(ij,l)=zq(ij,l)
-         enddo
-         do ij=1,ip1jm+1,iip1
-            q(ij+iim,l)=q(ij,l)
-         enddo
-      enddo
-
-      RETURN
-      END
-
-      SUBROUTINE advnqx(q,qg,qd)
-c
-c     Auteurs:   Calcul des valeurs de q aux point u.
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      real q(ip1jmp1,llm),qg(ip1jmp1,llm),qd(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l
-c
-      real dxqu(ip1jmp1),zqu(ip1jmp1)
-      real zqmax(ip1jmp1),zqmin(ip1jmp1)
-      logical extremum(ip1jmp1)
-
-      integer mode
-      save mode
-      data mode/1/
-
-c   calcul des pentes en u:
-c   -----------------------
-      if (mode.eq.0) then
-         do l=1,llm
-            do ij=1,ip1jm
-               qd(ij,l)=q(ij,l)
-               qg(ij,l)=q(ij,l)
-            enddo
-         enddo
-      else
-      do l = 1, llm
-         do ij=iip2,ip1jm-1
-            dxqu(ij)=q(ij+1,l)-q(ij,l)
-            zqu(ij)=0.5*(q(ij+1,l)+q(ij,l))
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            dxqu(ij)=dxqu(ij-iim)
-            zqu(ij)=zqu(ij-iim)
-         enddo
-         do ij=iip2,ip1jm-1
-            zqu(ij)=zqu(ij)-dxqu(ij+1)/12.
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            zqu(ij)=zqu(ij-iim)
-         enddo
-         do ij=iip2+1,ip1jm
-            zqu(ij)=zqu(ij)+dxqu(ij-1)/12.
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            zqu(ij-iim)=zqu(ij)
-         enddo
-
-c   calcul des valeurs max et min acceptees aux interfaces
-
-         do ij=iip2,ip1jm-1
-            zqmax(ij)=max(q(ij+1,l),q(ij,l))
-            zqmin(ij)=min(q(ij+1,l),q(ij,l))
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            zqmax(ij)=zqmax(ij-iim)
-            zqmin(ij)=zqmin(ij-iim)
-         enddo
-         do ij=iip2+1,ip1jm
-            extremum(ij)=dxqu(ij)*dxqu(ij-1).le.0.
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            extremum(ij-iim)=extremum(ij)
-         enddo
-         do ij=iip2,ip1jm
-            zqu(ij)=min(max(zqmin(ij),zqu(ij)),zqmax(ij))
-         enddo
-         do ij=iip2+1,ip1jm
-            if(extremum(ij)) then
-               qg(ij,l)=q(ij,l)
-               qd(ij,l)=q(ij,l)
-            else
-               qd(ij,l)=zqu(ij)
-               qg(ij,l)=zqu(ij-1)
-            endif
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            qd(ij-iim,l)=qd(ij,l)
-            qg(ij-iim,l)=qg(ij,l)
-         enddo
-
-         goto 8888
-
-         do ij=iip2+1,ip1jm
-            if(extremum(ij).and..not.extremum(ij-1))
-     s         qd(ij-1,l)=q(ij,l)
-         enddo
-
-         do ij=iip1+iip1,ip1jm,iip1
-            qd(ij-iim,l)=qd(ij,l)
-         enddo
-         do ij=iip2,ip1jm-1
-            if (extremum(ij).and..not.extremum(ij+1))
-     s         qg(ij+1,l)=q(ij,l)
-         enddo
-
-         do ij=iip1+iip1,ip1jm,iip1
-            qg(ij,l)=qg(ij-iim,l)
-         enddo
-8888     continue
-      enddo
-      endif
-      RETURN
-      END
-      SUBROUTINE advnqy(q,qs,qn)
-c
-c     Auteurs:   Calcul des valeurs de q aux point v.
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      real q(ip1jmp1,llm),qs(ip1jmp1,llm),qn(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l
-c
-      real dyqv(ip1jm),zqv(ip1jm,llm)
-      real zqmax(ip1jm),zqmin(ip1jm)
-      logical extremum(ip1jmp1)
-
-      integer mode
-      save mode
-      data mode/1/
-
-      if (mode.eq.0) then
-         do l=1,llm
-            do ij=1,ip1jmp1
-               qn(ij,l)=q(ij,l)
-               qs(ij,l)=q(ij,l)
-            enddo
-         enddo
-      else
-
-c   calcul des pentes en u:
-c   -----------------------
-      do l = 1, llm
-         do ij=1,ip1jm
-            dyqv(ij)=q(ij,l)-q(ij+iip1,l)
-         enddo
-
-         do ij=iip2,ip1jm-iip1
-            zqv(ij,l)=0.5*(q(ij+iip1,l)+q(ij,l))
-            zqv(ij,l)=zqv(ij,l)+(dyqv(ij+iip1)-dyqv(ij-iip1))/12.
-         enddo
-
-         do ij=iip2,ip1jm
-            extremum(ij)=dyqv(ij)*dyqv(ij-iip1).le.0.
-         enddo
-
-c Pas de pentes aux poles
-         do ij=1,iip1
-            zqv(ij,l)=q(ij,l)
-            zqv(ip1jm-iip1+ij,l)=q(ip1jm+ij,l)
-            extremum(ij)=.true.
-            extremum(ip1jmp1-iip1+ij)=.true.
-         enddo
-
-c   calcul des valeurs max et min acceptees aux interfaces
-         do ij=1,ip1jm
-            zqmax(ij)=max(q(ij+iip1,l),q(ij,l))
-            zqmin(ij)=min(q(ij+iip1,l),q(ij,l))
-         enddo
-
-         do ij=1,ip1jm
-            zqv(ij,l)=min(max(zqmin(ij),zqv(ij,l)),zqmax(ij))
-         enddo
-
-         do ij=iip2,ip1jm
-            if(extremum(ij)) then
-               qs(ij,l)=q(ij,l)
-               qn(ij,l)=q(ij,l)
-c              if (.not.extremum(ij-iip1)) qs(ij-iip1,l)=q(ij,l)
-c              if (.not.extremum(ij+iip1)) qn(ij+iip1,l)=q(ij,l)
-            else
-               qs(ij,l)=zqv(ij,l)
-               qn(ij,l)=zqv(ij-iip1,l)
-            endif
-         enddo
-
-         do ij=1,iip1
-            qs(ij,l)=q(ij,l)
-            qn(ij,l)=q(ij,l)
-            qs(ip1jm+ij,l)=q(ip1jm+ij,l)
-            qn(ip1jm+ij,l)=q(ip1jm+ij,l)
-         enddo
-
-      enddo
-      endif
-      RETURN
-      END
-
-      SUBROUTINE advnqz(q,qh,qb)
-c
-c     Auteurs:   Calcul des valeurs de q aux point v.
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      real q(ip1jmp1,llm),qh(ip1jmp1,llm),qb(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l
-c
-      real dzqw(ip1jmp1,llm+1),zqw(ip1jmp1,llm+1)
-      real zqmax(ip1jmp1,llm),zqmin(ip1jmp1,llm)
-      logical extremum(ip1jmp1,llm)
-
-      integer mode
-      save mode
-
-      data mode/1/
-
-c   calcul des pentes en u:
-c   -----------------------
-
-      if (mode.eq.0) then
-         do l=1,llm
-            do ij=1,ip1jmp1
-               qb(ij,l)=q(ij,l)
-               qh(ij,l)=q(ij,l)
-            enddo
-         enddo
-      else
-      do l = 2, llm
-         do ij=1,ip1jmp1
-            dzqw(ij,l)=q(ij,l-1)-q(ij,l)
-            zqw(ij,l)=0.5*(q(ij,l-1)+q(ij,l))
-         enddo
-      enddo
-      do ij=1,ip1jmp1
-         dzqw(ij,1)=0.
-         dzqw(ij,llm+1)=0.
-      enddo
-      do l=2,llm
-         do ij=1,ip1jmp1
-            zqw(ij,l)=zqw(ij,l)+(dzqw(ij,l+1)-dzqw(ij,l-1))/12.
-         enddo
-      enddo
-      do l=2,llm-1
-         do ij=1,ip1jmp1
-            extremum(ij,l)=dzqw(ij,l)*dzqw(ij,l+1).le.0.
-         enddo
-      enddo
-
-c Pas de pentes en bas et en haut
-         do ij=1,ip1jmp1
-            zqw(ij,2)=q(ij,1)
-            zqw(ij,llm)=q(ij,llm)
-            extremum(ij,1)=.true.
-            extremum(ij,llm)=.true.
-         enddo
-
-c   calcul des valeurs max et min acceptees aux interfaces
-      do l=2,llm
-         do ij=1,ip1jmp1
-            zqmax(ij,l)=max(q(ij,l-1),q(ij,l))
-            zqmin(ij,l)=min(q(ij,l-1),q(ij,l))
-         enddo
-      enddo
-
-      do l=2,llm
-         do ij=1,ip1jmp1
-            zqw(ij,l)=min(max(zqmin(ij,l),zqw(ij,l)),zqmax(ij,l))
-         enddo
-      enddo
-
-      do l=2,llm-1
-         do ij=1,ip1jmp1
-            if(extremum(ij,l)) then
-               qh(ij,l)=q(ij,l)
-               qb(ij,l)=q(ij,l)
-            else
-               qh(ij,l)=zqw(ij,l+1)
-               qb(ij,l)=zqw(ij,l)
-            endif
-         enddo
-      enddo
-c     do l=2,llm-1
-c        do ij=1,ip1jmp1
-c           if(extremum(ij,l)) then
-c              if (.not.extremum(ij,l-1)) qh(ij,l-1)=q(ij,l)
-c              if (.not.extremum(ij,l+1)) qb(ij,l+1)=q(ij,l)
-c           endif
-c        enddo
-c     enddo
-
-      do ij=1,ip1jmp1
-         qb(ij,1)=q(ij,1)
-         qh(ij,1)=q(ij,1)
-         qb(ij,llm)=q(ij,llm)
-         qh(ij,llm)=q(ij,llm)
-      enddo
-
-      endif
-
-      RETURN
-      END
-
-      SUBROUTINE advnx(q,qg,qd,masse,u_m,mode)
-c
-c     Auteur : F. Hourdin
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      integer mode
-      real masse(ip1jmp1,llm)
-      real u_m( ip1jmp1,llm )
-      real q(ip1jmp1,llm),qd(ip1jmp1,llm),qg(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER i,j,ij,l,indu(ip1jmp1),niju,iju,ijq
-      integer n0,nl(llm)
-c
-      real new_m,zu_m,zdq,zz
-      real zsigg(ip1jmp1,llm),zsigd(ip1jmp1,llm),zsig
-      real u_mq(ip1jmp1,llm)
-
-      real zm,zq,zsigm,zsigp,zqm,zqp,zu
-
-      logical ladvplus(ip1jmp1,llm)
-
-      real prec
-      save prec
-
-#ifdef CRAY
-      data prec/1.e-24/
-#else
-      data prec/1.e-15/
-#endif
-
-      do l=1,llm
-            do ij=iip2,ip1jm
-               zdq=qd(ij,l)-qg(ij,l)
-c              if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) then
-c                 print*,'probleme au point ij=',ij,'  l=',l
-c                 print*,qd(ij,l),q(ij,l),qg(ij,l)
-c                 qd(ij,l)=q(ij,l)
-c                 qg(ij,l)=q(ij,l)
-c              endif
-               if(abs(zdq).gt.prec) then
-                  zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq
-                  zsigg(ij,l)=1.-zsigd(ij,l)
-c                 if(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and.
-c    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) then
-c                    print*,'probleme au point ij=',ij,'  l=',l
-c                    print*,'sigg=',zsigg(ij,l),'  sigd=',zsigd(ij,l)
-c                    print*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq
-c                    stop
-c                 endif
-               else
-                  zsigd(ij,l)=0.5
-                  zsigg(ij,l)=0.5
-                  qd(ij,l)=q(ij,l)
-                  qg(ij,l)=q(ij,l)
-               endif
-            enddo
-       enddo
-
-c   calcul de la pente maximum dans la maille en valeur absolue
-
-       do l=1,llm
-       do ij=iip2,ip1jm-1
-          if (u_m(ij,l).ge.0.) then
-             zsigp=zsigd(ij,l)
-             zsigm=zsigg(ij,l)
-             zqp=qd(ij,l)
-             zqm=qg(ij,l)
-             zm=masse(ij,l)
-             zq=q(ij,l)
-          else
-             zsigm=zsigd(ij+1,l)
-             zsigp=zsigg(ij+1,l)
-             zqm=qd(ij+1,l)
-             zqp=qg(ij+1,l)
-             zm=masse(ij+1,l)
-             zq=q(ij+1,l)
-          endif
-          zu=abs(u_m(ij,l))
-          ladvplus(ij,l)=zu.gt.zm
-          zsig=zu/zm
-          if(zsig.eq.0.) zsigp=0.1
-          if (mode.eq.1) then
-             if (zsig.le.zsigp) then
-                 u_mq(ij,l)=u_m(ij,l)*zqp
-             else if (mode.eq.1) then
-                 u_mq(ij,l)=
-     s           sign(zm,u_m(ij,l))*(zsigp*zqp+(zsig-zsigp)*zqm)
-             endif 
-          else
-             if (zsig.le.zsigp) then
-                 u_mq(ij,l)=u_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
-             else
-                zz=0.5*(zsig-zsigp)/zsigm
-                u_mq(ij,l)=sign(zm,u_m(ij,l))*( 0.5*(zq+zqp)*zsigp
-     s          +(zsig-zsigp)*(zq+zz*(zqm-zq)) )
-             endif
-          endif
-c         if(zsig.lt.0.) then
-c            print*,'au point ij=',ij,'  l=',l,'  sig=',zsig
-c            stop
-c         endif
-      enddo
-      enddo
-
-      do l=1,llm
-       do ij=iip1+iip1,ip1jm,iip1
-          u_mq(ij,l)=u_mq(ij-iim,l)
-          ladvplus(ij,l)=ladvplus(ij-iim,l)
-       enddo
-      enddo
-
-c=================================================================
-C   SCHEMA SEMI-LAGRAGIEN EN X DANS LES REGIONS POLAIRES
-c=================================================================
-c   tris des regions a traiter
-      n0=0
-      do l=1,llm
-         nl(l)=0
-         do ij=iip2,ip1jm
-            if(ladvplus(ij,l)) then
-               nl(l)=nl(l)+1
-               u_mq(ij,l)=0.
-            endif
-         enddo
-         n0=n0+nl(l)
-      enddo
-
-      if(n0.gt.1) then
-      IF (prt_level > 9) WRITE(lunout,*)
-     & 'Nombre de points pour lesquels on advect plus que le'
-     &       ,'contenu de la maille : ',n0
-
-         do l=1,llm
-            if(nl(l).gt.0) then
-               iju=0
-c   indicage des mailles concernees par le traitement special
-               do ij=iip2,ip1jm
-                  if(ladvplus(ij,l).and.mod(ij,iip1).ne.0) then
-                     iju=iju+1
-                     indu(iju)=ij
-                  endif
-               enddo
-               niju=iju
-c              print*,'niju,nl',niju,nl(l)
-
-c  traitement des mailles
-               do iju=1,niju
-                  ij=indu(iju)
-                  j=(ij-1)/iip1+1
-                  zu_m=u_m(ij,l)
-                  u_mq(ij,l)=0.
-                  if(zu_m.gt.0.) then
-                     ijq=ij
-                     i=ijq-(j-1)*iip1
-c   accumulation pour les mailles completements advectees
-                     do while(zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m-masse(ijq,l)
-                        i=mod(i-2+iim,iim)+1
-                        ijq=(j-1)*iip1+i
-                     enddo
-c   MODIFS SPECIFIQUES DU SCHEMA
-c   ajout de la maille non completement advectee
-             zsig=zu_m/masse(ijq,l)
-             if(zsig.le.zsigd(ijq,l)) then
-                u_mq(ij,l)=u_mq(ij,l)+zu_m*(qd(ijq,l)
-     s          -0.5*zsig/zsigd(ijq,l)*(qd(ijq,l)-q(ijq,l)))
-             else
-c               u_mq(ij,l)=u_mq(ij,l)+zu_m*q(ijq,l)
-c         goto 8888
-                zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l)
-                if(.not.(zz.gt.0..and.zz.le.0.5)) then
-                     WRITE(lunout,*)'probleme2 au point ij=',ij,
-     s               '  l=',l
-                     WRITE(lunout,*)'zz=',zz
-                     stop
-                endif
-                u_mq(ij,l)=u_mq(ij,l)+masse(ijq,l)*(
-     s          0.5*(q(ijq,l)+qd(ijq,l))*zsigd(ijq,l)
-     s        +(zsig-zsigd(ijq,l))*(q(ijq,l)+zz*(qg(ijq,l)-q(ijq,l))) )
-             endif
-                  else
-                     ijq=ij+1
-                     i=ijq-(j-1)*iip1
-c   accumulation pour les mailles completements advectees
-                     do while(-zu_m.gt.masse(ijq,l))
-                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
-                        zu_m=zu_m+masse(ijq,l)
-                        i=mod(i,iim)+1
-                        ijq=(j-1)*iip1+i
-                     enddo
-c   ajout de la maille non completement advectee
-c 2eme MODIF SPECIFIQUE
-             zsig=-zu_m/masse(ij+1,l)
-             if(zsig.le.zsigg(ijq,l)) then
-                u_mq(ij,l)=u_mq(ij,l)+zu_m*(qg(ijq,l)
-     s          -0.5*zsig/zsigg(ijq,l)*(qg(ijq,l)-q(ijq,l)))
-             else
-c               u_mq(ij,l)=u_mq(ij,l)+zu_m*q(ijq,l)
-c           goto 9999
-                zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l)
-                if(.not.(zz.gt.0..and.zz.le.0.5)) then
-                     WRITE(lunout,*)'probleme22 au point ij=',ij
-     s               ,'  l=',l
-                     WRITE(lunout,*)'zz=',zz
-                     stop
-                endif
-                u_mq(ij,l)=u_mq(ij,l)-masse(ijq,l)*(
-     s          0.5*(q(ijq,l)+qg(ijq,l))*zsigg(ijq,l)
-     s          +(zsig-zsigg(ijq,l))*
-     s           (q(ijq,l)+zz*(qd(ijq,l)-q(ijq,l))) )
-             endif
-c   fin de la modif
-                  endif
-               enddo
-            endif
-         enddo
-      endif  ! n0.gt.0 
-
-c   bouclage en latitude
-      do l=1,llm
-        do ij=iip1+iip1,ip1jm,iip1
-           u_mq(ij,l)=u_mq(ij-iim,l)
-        enddo
-      enddo
-
-c=================================================================
-c   CALCUL DE LA CONVERGENCE DES FLUX
-c=================================================================
-
-      do l=1,llm
-         do ij=iip2+1,ip1jm
-            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+
-     &      u_mq(ij-1,l)-u_mq(ij,l))
-     &      /new_m
-            masse(ij,l)=new_m
-         enddo
-c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
-         do ij=iip1+iip1,ip1jm,iip1
-            q(ij-iim,l)=q(ij,l)
-            masse(ij-iim,l)=masse(ij,l)
-         enddo
-      enddo
-
-      RETURN
-      END
-      SUBROUTINE advny(q,qs,qn,masse,v_m)
-c
-c     Auteur : F. Hourdin
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      real masse(ip1jmp1,llm)
-      real v_m( ip1jm,llm )
-      real q(ip1jmp1,llm),qn(ip1jmp1,llm),qs(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l
-c
-      real new_m,zdq,zz
-      real zsigs(ip1jmp1),zsign(ip1jmp1),zsig
-      real v_mq(ip1jm,llm)
-      real convpn,convps,convmpn,convmps,massen,masses
-      real zm,zq,zsigm,zsigp,zqm,zqp
-      real ssum
-      real prec
-      save prec
-
-#ifdef CRAY
-      data prec/1.e-24/
-#else
-      data prec/1.e-15/
-#endif
-      do l=1,llm
-            do ij=1,ip1jmp1
-               zdq=qn(ij,l)-qs(ij,l)
-c              if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) then
-c                 print*,'probleme au point ij=',ij,'  l=',l,'  advnqx'
-c                 print*,qn(ij,l),q(ij,l),qs(ij,l)
-c                 qn(ij,l)=q(ij,l)
-c                 qs(ij,l)=q(ij,l)
-c              endif
-               if(abs(zdq).gt.prec) then
-                  zsign(ij)=(q(ij,l)-qs(ij,l))/zdq
-                  zsigs(ij)=1.-zsign(ij)
-c                 if(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and.
-c    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) then
-c                    print*,'probleme au point ij=',ij,'  l=',l
-c                    print*,'sigs=',zsigs(ij),'  sign=',zsign(ij)
-c                    stop
-c                 endif
-               else
-                  zsign(ij)=0.5
-                  zsigs(ij)=0.5
-               endif
-            enddo
-
-c   calcul de la pente maximum dans la maille en valeur absolue
-
-       do ij=1,ip1jm
-          if (v_m(ij,l).ge.0.) then
-             zsigp=zsign(ij+iip1)
-             zsigm=zsigs(ij+iip1)
-             zqp=qn(ij+iip1,l)
-             zqm=qs(ij+iip1,l)
-             zm=masse(ij+iip1,l)
-             zq=q(ij+iip1,l)
-          else
-             zsigm=zsign(ij)
-             zsigp=zsigs(ij)
-             zqm=qn(ij,l)
-             zqp=qs(ij,l)
-             zm=masse(ij,l)
-             zq=q(ij,l)
-          endif
-          zsig=abs(v_m(ij,l))/zm
-          if(zsig.eq.0.) zsigp=0.1
-          if (zsig.le.zsigp) then
-              v_mq(ij,l)=v_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
-          else
-              zz=0.5*(zsig-zsigp)/zsigm
-              v_mq(ij,l)=sign(zm,v_m(ij,l))*( 0.5*(zq+zqp)*zsigp 
-     s        +(zsig-zsigp)*(zq+zz*(zqm-zq)) )
-          endif
-       enddo
-      enddo
-
-      do l=1,llm
-         do ij=iip2,ip1jm
-            new_m=masse(ij,l)
-     &      +v_m(ij,l)-v_m(ij-iip1,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+v_mq(ij,l)-v_mq(ij-iip1,l))
-     &         /new_m
-            masse(ij,l)=new_m
-         enddo
-c.-. ancienne version
-         convpn=SSUM(iim,v_mq(1,l),1)
-         convmpn=ssum(iim,v_m(1,l),1)
-         massen=ssum(iim,masse(1,l),1)
-         new_m=massen+convmpn
-         q(1,l)=(q(1,l)*massen+convpn)/new_m
-         do ij = 1,iip1
-            q(ij,l)=q(1,l)
-            masse(ij,l)=new_m*aire(ij)/apoln
-         enddo
-
-         convps=-SSUM(iim,v_mq(ip1jm-iim,l),1)
-         convmps=-ssum(iim,v_m(ip1jm-iim,l),1)
-         masses=ssum(iim,masse(ip1jm+1,l),1)
-         new_m=masses+convmps
-         q(ip1jm+1,l)=(q(ip1jm+1,l)*masses+convps)/new_m
-         do ij = ip1jm+1,ip1jmp1
-            q(ij,l)=q(ip1jm+1,l)
-            masse(ij,l)=new_m*aire(ij)/apols
-         enddo
-      enddo
-
-      RETURN
-      END
-      SUBROUTINE advnz(q,qh,qb,masse,w_m)
-c
-c     Auteurs:   F.Hourdin
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c     b designe le bas et h le haut
-c     il y a une correspondance entre le b en z et le d en x
-c    ********************************************************************
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
-c
-c
-c   Arguments:
-c   ----------
-      real masse(ip1jmp1,llm)
-      real w_m( ip1jmp1,llm+1)
-      real q(ip1jmp1,llm),qb(ip1jmp1,llm),qh(ip1jmp1,llm)
-
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l
-c
-      real new_m,zdq,zz
-      real zsigh(ip1jmp1,llm),zsigb(ip1jmp1,llm),zsig
-      real w_mq(ip1jmp1,llm+1)
-      real zm,zq,zsigm,zsigp,zqm,zqp
-      real prec
-      save prec
-
-#ifdef CRAY
-      data prec/1.e-24/
-#else
-      data prec/1.e-13/
-#endif
-
-      do l=1,llm
-            do ij=1,ip1jmp1
-               zdq=qb(ij,l)-qh(ij,l)
-c              if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) then
-c                 print*,'probleme au point ij=',ij,'  l=',l
-c                 print*,qh(ij,l),q(ij,l),qb(ij,l)
-c                 qh(ij,l)=q(ij,l)
-c                 qb(ij,l)=q(ij,l)
-c              endif
-
-               if(abs(zdq).gt.prec) then
-                  zsigb(ij,l)=(q(ij,l)-qh(ij,l))/zdq
-                  zsigh(ij,l)=1.-zsigb(ij,l)
-                  zsigb(ij,l)=min(max(zsigb(ij,l),0.),1.)
-               else
-                  zsigb(ij,l)=0.5
-                  zsigh(ij,l)=0.5
-               endif
-            enddo
-       enddo
-
-c      print*,'ok1'
-c   calcul de la pente maximum dans la maille en valeur absolue
-       do l=2,llm
-       do ij=1,ip1jmp1
-          if (w_m(ij,l).ge.0.) then
-             zsigp=zsigb(ij,l)
-             zsigm=zsigh(ij,l)
-             zqp=qb(ij,l)
-             zqm=qh(ij,l)
-             zm=masse(ij,l)
-             zq=q(ij,l)
-          else
-             zsigm=zsigb(ij,l-1)
-             zsigp=zsigh(ij,l-1)
-             zqm=qb(ij,l-1)
-             zqp=qh(ij,l-1)
-             zm=masse(ij,l-1)
-             zq=q(ij,l-1)
-          endif
-          zsig=abs(w_m(ij,l))/zm
-          if(zsig.eq.0.) zsigp=0.1
-          if (zsig.le.zsigp) then
-              w_mq(ij,l)=w_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
-          else
-              zz=0.5*(zsig-zsigp)/zsigm
-              w_mq(ij,l)=sign(zm,w_m(ij,l))*( 0.5*(zq+zqp)*zsigp
-     s        +(zsig-zsigp)*(zq+zz*(zqm-zq)) )
-          endif
-      enddo
-      enddo
-
-       do ij=1,ip1jmp1
-          w_mq(ij,llm+1)=0.
-          w_mq(ij,1)=0.
-       enddo
-
-      do l=1,llm
-         do ij=1,ip1jmp1
-            new_m=masse(ij,l)+w_m(ij,l+1)-w_m(ij,l)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+w_mq(ij,l+1)-w_mq(ij,l))
-     &         /new_m
-            masse(ij,l)=new_m
-         enddo
-      enddo
-c     print*,'ok3'
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/advtrac_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advtrac_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/advtrac_loc.F	(revision 1999)
@@ -24,7 +24,7 @@
       USE Vampir
       USE times
-      USE infotrac
-      USE control_mod
-      USE advtrac_mod
+      USE infotrac, ONLY: nqtot, iadv
+      USE control_mod, ONLY: iapp_tracvl, day_step, planet_type
+      USE advtrac_mod, ONLY: finmasse
       IMPLICIT NONE
 c
Index: LMDZ5/branches/testing/libf/dyn3dmem/advx.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advx.F	(revision 1910)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE  advx(limit,dtx,pbaru,sm,s0,
-     $     sx,sy,sz,lati,latf)
-      IMPLICIT NONE
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                C
-C  first-order moments (FOM) advection of tracer in X direction  C
-C                                                                C
-C  Source : Pascal Simon (Meteo,CNRM)                            C
-C  Adaptation : A.Armengaud (LGGE) juin 94                       C
-C                                                                C
-C  limit,dtx,pbaru,pbarv,sm,s0,sx,sy,sz                       C
-C  sont des arguments d'entree pour le s-pg...                   C
-C                                                                C
-C  sm,s0,sx,sy,sz                                                C
-C  sont les arguments de sortie pour le s-pg                     C
-C								 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C  parametres principaux du modele
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-
-C  Arguments :
-C  -----------
-C  dtx : frequence fictive d'appel du transport 
-C  pbaru, pbarv : flux de masse en x et y en Pa.m2.s-1
-
-       INTEGER ntra
-       PARAMETER (ntra = 1)
-
-C ATTENTION partout ou on trouve ntra, insertion de boucle
-C           possible dans l'avenir.
-
-      REAL dtx
-      REAL pbaru ( iip1,jjp1,llm )
-
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C
-      REAL SM(iip1,jjp1,llm),S0(iip1,jjp1,llm,ntra)
-      REAL sx(iip1,jjp1,llm,ntra)
-     $    ,sy(iip1,jjp1,llm,ntra)
-      REAL sz(iip1,jjp1,llm,ntra)
-
-C  Local :
-C  ------- 
-
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-
-      REAL UGRI(iip1,jjp1,llm)
-
-C  Rem : VGRI et WGRI ne sont pas utilises dans 
-C  cette subroutine ( advection en x uniquement )
-C
-C  Ti are the moments for the current latitude and level
-C
-      REAL TM(iim)
-      REAL T0(iim,ntra),TX(iim,ntra)
-      REAL TY(iim,ntra),TZ(iim,ntra)
-      REAL TEMPTM                ! just a temporary variable
-C
-C  the moments F are similarly defined and used as temporary
-C  storage for portions of the grid boxes in transit
-C
-      REAL FM(iim)
-      REAL F0(iim,ntra),FX(iim,ntra)
-      REAL FY(iim,ntra),FZ(iim,ntra)
-C
-C  work arrays
-C
-      REAL ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
-C
-      REAL SMNEW(iim),UEXT(iim)
-C
-      REAL sqi,sqf
-
-      LOGICAL LIMIT
-      INTEGER NUM(jjp1),LONK,NUMK
-      INTEGER lon,lati,latf,niv
-      INTEGER i,i2,i3,j,jv,l,k,itrac 
-
-      lon = iim 
-      niv = llm 
-
-C *** Test de passage d'arguments ******
-
-
-C  -------------------------------------
-      DO 300 j = 1,jjp1 
-         NUM(j) = 1
-  300 CONTINUE
-      sqi = 0.
-      sqf = 0.
-
-      DO l = 1,llm
-         DO j = 1,jjp1
-            DO i = 1,iim
-               sqi = sqi + S0(i,j,l,ntra)
-            ENDDO
-         ENDDO
-      ENDDO
-      PRINT*,'-------- DIAG DANS ADVX - ENTREE ---------'
-      PRINT*,'sqi=',sqi
-
-
-C  Interface : adaptation nouveau modele
-C  -------------------------------------
-C
-C  ---------------------------------------------------------
-C  Conversion des flux de masses en kg/s
-C  pbaru est en N/s d'ou :
-C  ugri est en kg/s
-
-      DO 500 l = 1,llm
-         DO 500 j = 1,jjm+1
-            DO 500 i = 1,iip1  
-C            ugri (i,j,llm+1-l) = pbaru (i,j,l) * ( dsig(l) / g )
-             ugri (i,j,llm+1-l) = pbaru (i,j,l)
-  500 CONTINUE
-
-
-C  ---------------------------------------------------------
-C  ---------------------------------------------------------
-C  ---------------------------------------------------------
-  
-C  start here          
-C
-C  boucle principale sur les niveaux et les latitudes
-C
-      DO 1 L=1,NIV
-      DO 1 K=lati,latf
-C
-C  initialisation
-C
-C  program assumes periodic boundaries in X
-C
-      DO 10 I=2,LON
-         SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
- 10   CONTINUE
-      SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
-C
-C  modifications for extended polar zones
-C
-      NUMK=NUM(K)
-      LONK=LON/NUMK
-C
-      IF(NUMK.GT.1) THEN
-C
-      DO 111 I=1,LON
-         TM(I)=0.
- 111  CONTINUE
-      DO 112 JV=1,NTRA
-      DO 1120 I=1,LON
-         T0(I,JV)=0.
-         TX(I,JV)=0.
-         TY(I,JV)=0.
-         TZ(I,JV)=0.
- 1120 CONTINUE
- 112  CONTINUE
-C
-      DO 11 I2=1,NUMK
-C
-         DO 113 I=1,LONK
-            I3=(I-1)*NUMK+I2
-            TM(I)=TM(I)+SM(I3,K,L)
-            ALF(I)=SM(I3,K,L)/TM(I)
-            ALF1(I)=1.-ALF(I)
- 113     CONTINUE
-C
-         DO  JV=1,NTRA
-         DO  I=1,LONK
-            I3=(I-1)*NUMK+I2
-            TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)
-     $          *S0(I3,K,L,JV)
-            T0(I,JV)=T0(I,JV)+S0(I3,K,L,JV)
-            TX(I,JV)=ALF(I)  *sx(I3,K,L,JV)+
-     $       ALF1(I)*TX(I,JV) +3.*TEMPTM
-            TY(I,JV)=TY(I,JV)+sy(I3,K,L,JV)
-            TZ(I,JV)=TZ(I,JV)+sz(I3,K,L,JV)
-         ENDDO 
-         ENDDO
-C
- 11   CONTINUE
-C
-      ELSE
-C
-      DO 115 I=1,LON
-         TM(I)=SM(I,K,L)
- 115  CONTINUE
-      DO 116 JV=1,NTRA
-      DO 1160 I=1,LON
-         T0(I,JV)=S0(I,K,L,JV)
-         TX(I,JV)=sx(I,K,L,JV)
-         TY(I,JV)=sy(I,K,L,JV)
-         TZ(I,JV)=sz(I,K,L,JV)
- 1160 CONTINUE
- 116  CONTINUE
-C
-      ENDIF
-C
-      DO 117 I=1,LONK
-         UEXT(I)=UGRI(I*NUMK,K,L)
- 117  CONTINUE
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 13
-C
-      DO 12 JV=1,NTRA
-      DO 120 I=1,LONK
-        TX(I,JV)=SIGN(AMIN1(AMAX1(T0(I,JV),0.),ABS(TX(I,JV))),TX(I,JV))
- 120  CONTINUE
- 12   CONTINUE
-C
- 13   CONTINUE
-C
-C  calculate flux and moments between adjacent boxes
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-C  flux from IP to I if U(I).lt.0
-C
-      DO 140 I=1,LONK-1
-         IF(UEXT(I).LT.0.) THEN
-           FM(I)=-UEXT(I)*DTX
-           ALF(I)=FM(I)/TM(I+1)
-           TM(I+1)=TM(I+1)-FM(I)
-         ENDIF
- 140  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).LT.0.) THEN
-        FM(I)=-UEXT(I)*DTX
-        ALF(I)=FM(I)/TM(1)
-        TM(1)=TM(1)-FM(I)
-      ENDIF
-C
-C  flux from I to IP if U(I).gt.0
-C
-      DO 141 I=1,LONK
-         IF(UEXT(I).GE.0.) THEN
-           FM(I)=UEXT(I)*DTX
-           ALF(I)=FM(I)/TM(I)
-           TM(I)=TM(I)-FM(I)
-         ENDIF
- 141  CONTINUE
-C
-      DO 142 I=1,LONK
-         ALFQ(I)=ALF(I)*ALF(I)
-         ALF1(I)=1.-ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
- 142  CONTINUE
-C
-      DO 150 JV=1,NTRA
-      DO 1500 I=1,LONK-1
-C
-         IF(UEXT(I).LT.0.) THEN
-C
-           F0(I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*TX(I+1,JV) )
-           FX(I,JV)=ALFQ(I)*TX(I+1,JV)
-           FY(I,JV)=ALF (I)*TY(I+1,JV)
-           FZ(I,JV)=ALF (I)*TZ(I+1,JV)
-C
-           T0(I+1,JV)=T0(I+1,JV)-F0(I,JV)
-           TX(I+1,JV)=ALF1Q(I)*TX(I+1,JV)
-           TY(I+1,JV)=TY(I+1,JV)-FY(I,JV)
-           TZ(I+1,JV)=TZ(I+1,JV)-FZ(I,JV)
-C
-         ENDIF
-C
- 1500 CONTINUE
- 150  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).LT.0.) THEN
-C
-        DO 151 JV=1,NTRA
-C
-           F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*TX(1,JV) )
-           FX (I,JV)=ALFQ(I)*TX(1,JV)
-           FY (I,JV)=ALF (I)*TY(1,JV)
-           FZ (I,JV)=ALF (I)*TZ(1,JV)
-C
-           T0(1,JV)=T0(1,JV)-F0(I,JV)
-           TX(1,JV)=ALF1Q(I)*TX(1,JV)
-           TY(1,JV)=TY(1,JV)-FY(I,JV)
-           TZ(1,JV)=TZ(1,JV)-FZ(I,JV)
-C
- 151    CONTINUE
-C
-      ENDIF
-C
-      DO 152 JV=1,NTRA
-      DO 1520 I=1,LONK
-C
-         IF(UEXT(I).GE.0.) THEN
-C
-           F0(I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*TX(I,JV) )
-           FX(I,JV)=ALFQ(I)*TX(I,JV)
-           FY(I,JV)=ALF (I)*TY(I,JV)
-           FZ(I,JV)=ALF (I)*TZ(I,JV)
-C
-           T0(I,JV)=T0(I,JV)-F0(I,JV)
-           TX(I,JV)=ALF1Q(I)*TX(I,JV)
-           TY(I,JV)=TY(I,JV)-FY(I,JV)
-           TZ(I,JV)=TZ(I,JV)-FZ(I,JV)
-C
-         ENDIF
-C
- 1520 CONTINUE
- 152  CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 160 I=1,LONK
-         IF(UEXT(I).LT.0.) THEN
-           TM(I)=TM(I)+FM(I)
-           ALF(I)=FM(I)/TM(I)
-         ENDIF
- 160  CONTINUE
-C
-      DO 161 I=1,LONK-1
-         IF(UEXT(I).GE.0.) THEN
-           TM(I+1)=TM(I+1)+FM(I)
-           ALF(I)=FM(I)/TM(I+1)
-         ENDIF
- 161  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).GE.0.) THEN
-        TM(1)=TM(1)+FM(I)
-        ALF(I)=FM(I)/TM(1)
-      ENDIF
-C
-      DO 162 I=1,LONK
-         ALF1(I)=1.-ALF(I)
- 162  CONTINUE
-C
-      DO 170 JV=1,NTRA
-      DO 1700 I=1,LONK
-C
-         IF(UEXT(I).LT.0.) THEN
-C
-           TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
-           T0(I,JV)=T0(I,JV)+F0(I,JV)
-           TX(I,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(I,JV)+3.*TEMPTM
-           TY(I,JV)=TY(I,JV)+FY(I,JV)
-           TZ(I,JV)=TZ(I,JV)+FZ(I,JV)
-C
-         ENDIF
-C
- 1700 CONTINUE
- 170  CONTINUE
-C
-      DO 171 JV=1,NTRA
-      DO 1710 I=1,LONK-1
-C
-         IF(UEXT(I).GE.0.) THEN
-C
-           TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
-           T0(I+1,JV)=T0(I+1,JV)+F0(I,JV)
-           TX(I+1,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(I+1,JV)+3.*TEMPTM
-           TY(I+1,JV)=TY(I+1,JV)+FY(I,JV)
-           TZ(I+1,JV)=TZ(I+1,JV)+FZ(I,JV)
-C
-         ENDIF
-C
- 1710 CONTINUE
- 171  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).GE.0.) THEN
-        DO 172 JV=1,NTRA
-           TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
-           T0(1,JV)=T0(1,JV)+F0(I,JV)
-           TX(1,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(1,JV)+3.*TEMPTM
-           TY(1,JV)=TY(1,JV)+FY(I,JV)
-           TZ(1,JV)=TZ(1,JV)+FZ(I,JV)
- 172    CONTINUE
-      ENDIF
-C
-C  retour aux mailles d'origine (passage des Tij aux Sij)
-C
-      IF(NUMK.GT.1) THEN
-C
-      DO 180 I2=1,NUMK
-C
-         DO 180 I=1,LONK
-C
-            I3=I2+(I-1)*NUMK
-            SM(I3,K,L)=SMNEW(I3)
-            ALF(I)=SMNEW(I3)/TM(I)
-            TM(I)=TM(I)-SMNEW(I3)
-C
-            ALFQ(I)=ALF(I)*ALF(I)
-            ALF1(I)=1.-ALF(I)
-            ALF1Q(I)=ALF1(I)*ALF1(I)
-C
- 180     CONTINUE
-C
-         DO  JV=1,NTRA
-         DO  I=1,LONK
-C
-            I3=I2+(I-1)*NUMK
-            S0(I3,K,L,JV)=ALF (I)
-     $       * (T0(I,JV)-ALF1(I)*TX(I,JV))
-            sx(I3,K,L,JV)=ALFQ(I)*TX(I,JV)
-            sy(I3,K,L,JV)=ALF (I)*TY(I,JV)
-            sz(I3,K,L,JV)=ALF (I)*TZ(I,JV)
-C
-C   reajusts moments remaining in the box
-C
-            T0(I,JV)=T0(I,JV)-S0(I3,K,L,JV)
-            TX(I,JV)=ALF1Q(I)*TX(I,JV)
-            TY(I,JV)=TY(I,JV)-sy(I3,K,L,JV)
-            TZ(I,JV)=TZ(I,JV)-sz(I3,K,L,JV)
-          ENDDO
-          ENDDO
-C
-C
-      ELSE
-C
-      DO 190 I=1,LON
-         SM(I,K,L)=TM(I)
- 190  CONTINUE
-      DO 191 JV=1,NTRA
-      DO 1910 I=1,LON
-         S0(I,K,L,JV)=T0(I,JV)
-         sx(I,K,L,JV)=TX(I,JV)
-         sy(I,K,L,JV)=TY(I,JV)
-         sz(I,K,L,JV)=TZ(I,JV)
- 1910 CONTINUE
- 191  CONTINUE
-C
-      ENDIF
-C
- 1    CONTINUE
-C
-C ----------- AA Test en fin de ADVX ------ Controle des S*
-c OK
-c      DO 9998 l = 1, llm
-c      DO 9998 j = 1, jjp1
-c      DO 9998 i = 1, iip1
-c         IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN 
-c            PRINT*, '-------------------'
-c            PRINT*, 'En fin de ADVX'
-c            PRINT*,'SM(',i,j,l,')=',SM(i,j,l)
-c            PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
-c            print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
-c            print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
-c            print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
-c            WRITE (*,*) 'On arrete !! - pbl en fin de ADVX1'
-cc            STOP
-c         ENDIF
-c 9998 CONTINUE
-c
-C ---------- bouclage cyclique 
-      DO itrac=1,ntra
-      DO l = 1,llm
-        DO j = lati,latf
-           SM(iip1,j,l) = SM(1,j,l)
-           S0(iip1,j,l,itrac) = S0(1,j,l,itrac)
-           sx(iip1,j,l,itrac) = sx(1,j,l,itrac)
-           sy(iip1,j,l,itrac) = sy(1,j,l,itrac)
-           sz(iip1,j,l,itrac) = sz(1,j,l,itrac)
-        END DO
-      END DO
-      ENDDO 
-
-c ----------- qqtite totale de traceur dans tte l'atmosphere
-      DO l = 1, llm
-        DO j = 1, jjp1
-          DO i = 1, iim
-             sqf = sqf + S0(i,j,l,ntra)
-          END DO  
-        END DO
-      END DO
-c
-      PRINT*,'------ DIAG DANS ADVX - SORTIE -----'
-      PRINT*,'sqf=',sqf
-c-------------
-
-      RETURN
-      END
-C_________________________________________________________________
-C_________________________________________________________________
Index: LMDZ5/branches/testing/libf/dyn3dmem/advxp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advxp.F	(revision 1910)
+++ 	(revision )
@@ -1,650 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE ADVXP(LIMIT,DTX,PBARU,SM,S0,SSX,SY,SZ
-     .                ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra)
-       IMPLICIT NONE
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                 C
-C  second-order moments (SOM) advection of tracer in X direction  C
-C                                                                 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C  parametres principaux du modele
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-
-       INTEGER ntra
-c      PARAMETER (ntra = 1)
-C
-C  definition de la grille du modele
-C
-      REAL dtx
-      REAL pbaru ( iip1,jjp1,llm )
-C
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C           Sij 2nd  order moment in i and j directions
-C
-      REAL SM(iip1,jjp1,llm)
-     +    ,S0(iip1,jjp1,llm,ntra)
-      REAL SSX(iip1,jjp1,llm,ntra)
-     +    ,SY(iip1,jjp1,llm,ntra)
-     +    ,SZ(iip1,jjp1,llm,ntra)
-      REAL SSXX(iip1,jjp1,llm,ntra)
-     +    ,SSXY(iip1,jjp1,llm,ntra)
-     +    ,SSXZ(iip1,jjp1,llm,ntra)
-     +    ,SYY(iip1,jjp1,llm,ntra)
-     +    ,SYZ(iip1,jjp1,llm,ntra)
-     +    ,SZZ(iip1,jjp1,llm,ntra)
-
-C  Local :
-C  -------
-
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-
-       REAL UGRI(iip1,jjp1,llm)
-
-C  Rem : VGRI et WGRI ne sont pas utilises dans
-C  cette subroutine ( advection en x uniquement )
-C
-C
-C  Tij are the moments for the current latitude and level
-C
-      REAL TM (iim)
-      REAL T0 (iim,NTRA),TX (iim,NTRA)
-      REAL TY (iim,NTRA),TZ (iim,NTRA)
-      REAL TXX(iim,NTRA),TXY(iim,NTRA)
-      REAL TXZ(iim,NTRA),TYY(iim,NTRA)
-      REAL TYZ(iim,NTRA),TZZ(iim,NTRA)
-C
-C  the moments F are similarly defined and used as temporary
-C  storage for portions of the grid boxes in transit
-C
-      REAL FM (iim)
-      REAL F0 (iim,NTRA),FX (iim,NTRA)
-      REAL FY (iim,NTRA),FZ (iim,NTRA)
-      REAL FXX(iim,NTRA),FXY(iim,NTRA)
-      REAL FXZ(iim,NTRA),FYY(iim,NTRA)
-      REAL FYZ(iim,NTRA),FZZ(iim,NTRA)
-C
-C  work arrays
-C
-      REAL ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
-      REAL ALF2(iim),ALF3(iim),ALF4(iim)
-C
-      REAL SMNEW(iim),UEXT(iim)
-      REAL sqi,sqf
-      REAL TEMPTM
-      REAL SLPMAX
-      REAL S1MAX,S1NEW,S2NEW
-
-      LOGICAL LIMIT
-      INTEGER NUM(jjp1),LONK,NUMK
-      INTEGER lon,lati,latf,niv
-      INTEGER i,i2,i3,j,jv,l,k,iter
-
-      lon = iim
-      lati=2
-      latf = jjm
-      niv = llm
-
-C *** Test de passage d'arguments ******
-
-c      DO 399 l = 1, llm
-c       DO 399 j = 1, jjp1
-c        DO 399 i = 1, iip1
-c         IF (S0(i,j,l,ntra) .lt. 0. ) THEN
-c         PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
-c	     print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
-c         print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
-c         print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
-c         PRINT*, 'AIE !! debut ADVXP - pbl arg. passage dans ADVXP'
-cc            STOP
-c         ENDIF
-c  399 CONTINUE
-
-C *** Test : diagnostique de la qtite totale de traceur
-C            dans l'atmosphere avant l'advection
-c
-      sqi =0.
-      sqf =0.
-c
-      DO l = 1, llm
-      DO j = 1, jjp1
-      DO i = 1, iim
-	 sqi = sqi + S0(i,j,l,ntra)
-      END DO
-      END DO
-      END DO
-      PRINT*,'------ DIAG DANS ADVX2 - ENTREE -----'
-      PRINT*,'sqi=',sqi
-c test
-c  -------------------------------------
-        DO 300 j =1,jjp1
-         NUM(j) =1 
- 300  CONTINUE
-c       DO l=1,llm
-c      NUM(2,l)=6
-c      NUM(3,l)=6
-c      NUM(jjm-1,l)=6  
-c      NUM(jjm,l)=6
-c      ENDDO
-c        DO j=2,6
-c       NUM(j)=12
-c       ENDDO
-c       DO j=jjm-5,jjm-1 
-c       NUM(j)=12
-c       ENDDO
-
-C  Interface : adaptation nouveau modele
-C  -------------------------------------
-C
-C  ---------------------------------------------------------
-C  Conversion des flux de masses en kg/s
-C  pbaru est en N/s d'ou :
-C  ugri est en kg/s
-
-       DO 500 l = 1,llm
-       DO 500 j = 1,jjp1
-       DO 500 i = 1,iip1
-       ugri (i,j,llm+1-l) =pbaru (i,j,l) 
- 500   CONTINUE
-
-C  ---------------------------------------------------------
-C  start here
-C
-C  boucle principale sur les niveaux et les latitudes
-C     
-      DO 1 L=1,NIV
-      DO 1 K=lati,latf
-
-C
-C  initialisation
-C
-C  program assumes periodic boundaries in X
-C
-      DO 10 I=2,LON
-         SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
- 10   CONTINUE
-      SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
-C
-C  modifications for extended polar zones
-C
-      NUMK=NUM(K)
-      LONK=LON/NUMK
-C
-      IF(NUMK.GT.1) THEN
-C
-      DO 111 I=1,LON
-         TM(I)=0.
- 111  CONTINUE
-      DO 112 JV=1,NTRA
-      DO 1120 I=1,LON
-         T0 (I,JV)=0.
-         TX (I,JV)=0.
-         TY (I,JV)=0.
-         TZ (I,JV)=0.
-         TXX(I,JV)=0.
-         TXY(I,JV)=0.
-         TXZ(I,JV)=0.
-         TYY(I,JV)=0.
-         TYZ(I,JV)=0.
-         TZZ(I,JV)=0.
- 1120 CONTINUE
- 112  CONTINUE
-C
-      DO 11 I2=1,NUMK
-C
-         DO 113 I=1,LONK
-            I3=(I-1)*NUMK+I2
-            TM(I)=TM(I)+SM(I3,K,L)
-            ALF(I)=SM(I3,K,L)/TM(I)
-            ALF1(I)=1.-ALF(I)
-            ALFQ(I)=ALF(I)*ALF(I)
-            ALF1Q(I)=ALF1(I)*ALF1(I)
-            ALF2(I)=ALF1(I)-ALF(I)
-            ALF3(I)=ALF(I)*ALF1(I)
- 113     CONTINUE
-C
-         DO 114 JV=1,NTRA
-         DO 1140 I=1,LONK
-            I3=(I-1)*NUMK+I2
-            TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*S0(I3,K,L,JV)
-            T0 (I,JV)=T0(I,JV)+S0(I3,K,L,JV)
-            TXX(I,JV)=ALFQ(I)*SSXX(I3,K,L,JV)+ALF1Q(I)*TXX(I,JV)
-     +        +5.*( ALF3(I)*(SSX(I3,K,L,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
-            TX (I,JV)=ALF(I)*SSX(I3,K,L,JV)+ALF1(I)*TX(I,JV)+3.*TEMPTM
-            TXY(I,JV)=ALF (I)*SSXY(I3,K,L,JV)+ALF1(I)*TXY(I,JV)
-     +           +3.*(ALF1(I)*SY (I3,K,L,JV)-ALF (I)*TY (I,JV))
-            TXZ(I,JV)=ALF (I)*SSXZ(I3,K,L,JV)+ALF1(I)*TXZ(I,JV)
-     +           +3.*(ALF1(I)*SZ (I3,K,L,JV)-ALF (I)*TZ (I,JV))
-            TY (I,JV)=TY (I,JV)+SY (I3,K,L,JV)
-            TZ (I,JV)=TZ (I,JV)+SZ (I3,K,L,JV)
-            TYY(I,JV)=TYY(I,JV)+SYY(I3,K,L,JV)
-            TYZ(I,JV)=TYZ(I,JV)+SYZ(I3,K,L,JV)
-            TZZ(I,JV)=TZZ(I,JV)+SZZ(I3,K,L,JV)
- 1140    CONTINUE
- 114     CONTINUE
-C
- 11   CONTINUE
-C
-      ELSE
-C
-      DO 115 I=1,LON
-         TM(I)=SM(I,K,L)
- 115  CONTINUE
-      DO 116 JV=1,NTRA
-      DO 1160 I=1,LON
-         T0 (I,JV)=S0 (I,K,L,JV)
-         TX (I,JV)=SSX (I,K,L,JV)
-         TY (I,JV)=SY (I,K,L,JV)
-         TZ (I,JV)=SZ (I,K,L,JV)
-         TXX(I,JV)=SSXX(I,K,L,JV)
-         TXY(I,JV)=SSXY(I,K,L,JV)
-         TXZ(I,JV)=SSXZ(I,K,L,JV)
-         TYY(I,JV)=SYY(I,K,L,JV)
-         TYZ(I,JV)=SYZ(I,K,L,JV)
-         TZZ(I,JV)=SZZ(I,K,L,JV)
- 1160 CONTINUE
- 116  CONTINUE
-C
-      ENDIF
-C
-      DO 117 I=1,LONK
-         UEXT(I)=UGRI(I*NUMK,K,L)
- 117  CONTINUE
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 13
-C
-      DO 12 JV=1,NTRA
-      DO 120 I=1,LONK
-        IF(T0(I,JV).GT.0.) THEN
-          SLPMAX=T0(I,JV)
-          S1MAX=1.5*SLPMAX
-          S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,TX(I,JV)))
-          S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
-     +                 AMAX1(ABS(S1NEW)-SLPMAX,TXX(I,JV)) )
-          TX (I,JV)=S1NEW
-          TXX(I,JV)=S2NEW
-          TXY(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXY(I,JV)))
-          TXZ(I,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,TXZ(I,JV)))
-        ELSE
-          TX (I,JV)=0.
-          TXX(I,JV)=0.
-          TXY(I,JV)=0.
-          TXZ(I,JV)=0.
-        ENDIF
- 120  CONTINUE
- 12   CONTINUE
-C
- 13   CONTINUE
-C
-C  calculate flux and moments between adjacent boxes
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-C  flux from IP to I if U(I).lt.0
-C
-      DO 140 I=1,LONK-1
-         IF(UEXT(I).LT.0.) THEN
-           FM(I)=-UEXT(I)*DTX
-           ALF(I)=FM(I)/TM(I+1)
-           TM(I+1)=TM(I+1)-FM(I)
-         ENDIF
- 140  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).LT.0.) THEN
-        FM(I)=-UEXT(I)*DTX
-        ALF(I)=FM(I)/TM(1)
-        TM(1)=TM(1)-FM(I)
-      ENDIF
-C
-C  flux from I to IP if U(I).gt.0
-C
-      DO 141 I=1,LONK
-         IF(UEXT(I).GE.0.) THEN
-           FM(I)=UEXT(I)*DTX
-           ALF(I)=FM(I)/TM(I)
-           TM(I)=TM(I)-FM(I)
-         ENDIF
- 141  CONTINUE
-C
-      DO 142 I=1,LONK
-         ALFQ(I)=ALF(I)*ALF(I)
-         ALF1(I)=1.-ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-         ALF2(I)=ALF1(I)-ALF(I)
-         ALF3(I)=ALF(I)*ALFQ(I)
-         ALF4(I)=ALF1(I)*ALF1Q(I)
- 142  CONTINUE
-C
-      DO 150 JV=1,NTRA
-      DO 1500 I=1,LONK-1
-C
-         IF(UEXT(I).LT.0.) THEN
-C
-           F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*
-     +             ( TX(I+1,JV)-ALF2(I)*TXX(I+1,JV) ) )
-           FX (I,JV)=ALFQ(I)*(TX(I+1,JV)-3.*ALF1(I)*TXX(I+1,JV))
-           FXX(I,JV)=ALF3(I)*TXX(I+1,JV)
-           FY (I,JV)=ALF (I)*(TY(I+1,JV)-ALF1(I)*TXY(I+1,JV))
-           FZ (I,JV)=ALF (I)*(TZ(I+1,JV)-ALF1(I)*TXZ(I+1,JV))
-           FXY(I,JV)=ALFQ(I)*TXY(I+1,JV)
-           FXZ(I,JV)=ALFQ(I)*TXZ(I+1,JV)
-           FYY(I,JV)=ALF (I)*TYY(I+1,JV)
-           FYZ(I,JV)=ALF (I)*TYZ(I+1,JV)
-           FZZ(I,JV)=ALF (I)*TZZ(I+1,JV)
-C
-           T0 (I+1,JV)=T0(I+1,JV)-F0(I,JV)
-           TX (I+1,JV)=ALF1Q(I)*(TX(I+1,JV)+3.*ALF(I)*TXX(I+1,JV))
-           TXX(I+1,JV)=ALF4(I)*TXX(I+1,JV)
-           TY (I+1,JV)=TY (I+1,JV)-FY (I,JV)
-           TZ (I+1,JV)=TZ (I+1,JV)-FZ (I,JV)
-           TYY(I+1,JV)=TYY(I+1,JV)-FYY(I,JV)
-           TYZ(I+1,JV)=TYZ(I+1,JV)-FYZ(I,JV)
-           TZZ(I+1,JV)=TZZ(I+1,JV)-FZZ(I,JV)
-           TXY(I+1,JV)=ALF1Q(I)*TXY(I+1,JV)
-           TXZ(I+1,JV)=ALF1Q(I)*TXZ(I+1,JV)
-C
-         ENDIF
-C
- 1500 CONTINUE
- 150  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).LT.0.) THEN
-C
-        DO 151 JV=1,NTRA
-C
-           F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*
-     +             ( TX(1,JV)-ALF2(I)*TXX(1,JV) ) )
-           FX (I,JV)=ALFQ(I)*(TX(1,JV)-3.*ALF1(I)*TXX(1,JV))
-           FXX(I,JV)=ALF3(I)*TXX(1,JV)
-           FY (I,JV)=ALF (I)*(TY(1,JV)-ALF1(I)*TXY(1,JV))
-           FZ (I,JV)=ALF (I)*(TZ(1,JV)-ALF1(I)*TXZ(1,JV))
-           FXY(I,JV)=ALFQ(I)*TXY(1,JV)
-           FXZ(I,JV)=ALFQ(I)*TXZ(1,JV)
-           FYY(I,JV)=ALF (I)*TYY(1,JV)
-           FYZ(I,JV)=ALF (I)*TYZ(1,JV)
-           FZZ(I,JV)=ALF (I)*TZZ(1,JV)
-C
-           T0 (1,JV)=T0(1,JV)-F0(I,JV)
-           TX (1,JV)=ALF1Q(I)*(TX(1,JV)+3.*ALF(I)*TXX(1,JV))
-           TXX(1,JV)=ALF4(I)*TXX(1,JV)
-           TY (1,JV)=TY (1,JV)-FY (I,JV)
-           TZ (1,JV)=TZ (1,JV)-FZ (I,JV)
-           TYY(1,JV)=TYY(1,JV)-FYY(I,JV)
-           TYZ(1,JV)=TYZ(1,JV)-FYZ(I,JV)
-           TZZ(1,JV)=TZZ(1,JV)-FZZ(I,JV)
-           TXY(1,JV)=ALF1Q(I)*TXY(1,JV)
-           TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
-C
- 151    CONTINUE
-C
-      ENDIF
-C
-      DO 152 JV=1,NTRA
-      DO 1520 I=1,LONK
-C
-         IF(UEXT(I).GE.0.) THEN
-C
-           F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*
-     +             ( TX(I,JV)+ALF2(I)*TXX(I,JV) ) )
-           FX (I,JV)=ALFQ(I)*(TX(I,JV)+3.*ALF1(I)*TXX(I,JV))
-           FXX(I,JV)=ALF3(I)*TXX(I,JV)
-           FY (I,JV)=ALF (I)*(TY(I,JV)+ALF1(I)*TXY(I,JV))
-           FZ (I,JV)=ALF (I)*(TZ(I,JV)+ALF1(I)*TXZ(I,JV))
-           FXY(I,JV)=ALFQ(I)*TXY(I,JV)
-           FXZ(I,JV)=ALFQ(I)*TXZ(I,JV)
-           FYY(I,JV)=ALF (I)*TYY(I,JV)
-           FYZ(I,JV)=ALF (I)*TYZ(I,JV)
-           FZZ(I,JV)=ALF (I)*TZZ(I,JV)
-C
-           T0 (I,JV)=T0(I,JV)-F0(I,JV)
-           TX (I,JV)=ALF1Q(I)*(TX(I,JV)-3.*ALF(I)*TXX(I,JV))
-           TXX(I,JV)=ALF4(I)*TXX(I,JV)
-           TY (I,JV)=TY (I,JV)-FY (I,JV)
-           TZ (I,JV)=TZ (I,JV)-FZ (I,JV)
-           TYY(I,JV)=TYY(I,JV)-FYY(I,JV)
-           TYZ(I,JV)=TYZ(I,JV)-FYZ(I,JV)
-           TZZ(I,JV)=TZZ(I,JV)-FZZ(I,JV)
-           TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
-           TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
-C
-         ENDIF
-C
- 1520 CONTINUE
- 152  CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 160 I=1,LONK
-         IF(UEXT(I).LT.0.) THEN
-           TM(I)=TM(I)+FM(I)
-           ALF(I)=FM(I)/TM(I)
-         ENDIF
- 160  CONTINUE
-C
-      DO 161 I=1,LONK-1
-         IF(UEXT(I).GE.0.) THEN
-           TM(I+1)=TM(I+1)+FM(I)
-           ALF(I)=FM(I)/TM(I+1)
-         ENDIF
- 161  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).GE.0.) THEN
-        TM(1)=TM(1)+FM(I)
-        ALF(I)=FM(I)/TM(1)
-      ENDIF
-C
-      DO 162 I=1,LONK
-         ALF1(I)=1.-ALF(I)
-         ALFQ(I)=ALF(I)*ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-         ALF2(I)=ALF1(I)-ALF(I)
-         ALF3(I)=ALF(I)*ALF1(I)
- 162  CONTINUE
-C
-      DO 170 JV=1,NTRA
-      DO 1700 I=1,LONK
-C
-         IF(UEXT(I).LT.0.) THEN
-C
-           TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
-           T0 (I,JV)=T0(I,JV)+F0(I,JV)
-           TXX(I,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I,JV)
-     +          +5.*( ALF3(I)*(FX(I,JV)-TX(I,JV))+ALF2(I)*TEMPTM )
-           TX (I,JV)=ALF (I)*FX (I,JV)+ALF1(I)*TX (I,JV)+3.*TEMPTM
-           TXY(I,JV)=ALF (I)*FXY(I,JV)+ALF1(I)*TXY(I,JV)
-     +          +3.*(ALF1(I)*FY (I,JV)-ALF (I)*TY (I,JV))
-           TXZ(I,JV)=ALF (I)*FXZ(I,JV)+ALF1(I)*TXZ(I,JV)
-     +          +3.*(ALF1(I)*FZ (I,JV)-ALF (I)*TZ (I,JV))
-           TY (I,JV)=TY (I,JV)+FY (I,JV)
-           TZ (I,JV)=TZ (I,JV)+FZ (I,JV)
-           TYY(I,JV)=TYY(I,JV)+FYY(I,JV)
-           TYZ(I,JV)=TYZ(I,JV)+FYZ(I,JV)
-           TZZ(I,JV)=TZZ(I,JV)+FZZ(I,JV)
-C
-         ENDIF
-C
- 1700 CONTINUE
- 170  CONTINUE
-C
-      DO 171 JV=1,NTRA
-      DO 1710 I=1,LONK-1
-C
-         IF(UEXT(I).GE.0.) THEN
-C
-           TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
-           T0 (I+1,JV)=T0(I+1,JV)+F0(I,JV)
-           TXX(I+1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(I+1,JV)
-     +           +5.*( ALF3(I)*(TX(I+1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
-           TX (I+1,JV)=ALF(I)*FX (I  ,JV)+ALF1(I)*TX (I+1,JV)+3.*TEMPTM
-           TXY(I+1,JV)=ALF(I)*FXY(I  ,JV)+ALF1(I)*TXY(I+1,JV)
-     +            +3.*(ALF(I)*TY (I+1,JV)-ALF1(I)*FY (I  ,JV))
-           TXZ(I+1,JV)=ALF(I)*FXZ(I  ,JV)+ALF1(I)*TXZ(I+1,JV)
-     +            +3.*(ALF(I)*TZ (I+1,JV)-ALF1(I)*FZ (I  ,JV))
-           TY (I+1,JV)=TY (I+1,JV)+FY (I,JV)
-           TZ (I+1,JV)=TZ (I+1,JV)+FZ (I,JV)
-           TYY(I+1,JV)=TYY(I+1,JV)+FYY(I,JV)
-           TYZ(I+1,JV)=TYZ(I+1,JV)+FYZ(I,JV)
-           TZZ(I+1,JV)=TZZ(I+1,JV)+FZZ(I,JV)
-C
-         ENDIF
-C
- 1710 CONTINUE
- 171  CONTINUE
-C
-      I=LONK
-      IF(UEXT(I).GE.0.) THEN
-        DO 172 JV=1,NTRA
-           TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
-           T0 (1,JV)=T0(1,JV)+F0(I,JV)
-           TXX(1,JV)=ALFQ(I)*FXX(I,JV)+ALF1Q(I)*TXX(1,JV)
-     +         +5.*( ALF3(I)*(TX(1,JV)-FX(I,JV))-ALF2(I)*TEMPTM )
-           TX (1,JV)=ALF(I)*FX(I,JV)+ALF1(I)*TX(1,JV)+3.*TEMPTM
-           TXY(1,JV)=ALF(I)*FXY(I,JV)+ALF1(I)*TXY(1,JV)
-     +          +3.*(ALF(I)*TY (1,JV)-ALF1(I)*FY (I,JV))
-           TXZ(1,JV)=ALF(I)*FXZ(I,JV)+ALF1(I)*TXZ(1,JV)
-     +          +3.*(ALF(I)*TZ (1,JV)-ALF1(I)*FZ (I,JV))
-           TY (1,JV)=TY (1,JV)+FY (I,JV)
-           TZ (1,JV)=TZ (1,JV)+FZ (I,JV)
-           TYY(1,JV)=TYY(1,JV)+FYY(I,JV)
-           TYZ(1,JV)=TYZ(1,JV)+FYZ(I,JV)
-           TZZ(1,JV)=TZZ(1,JV)+FZZ(I,JV)
- 172    CONTINUE
-      ENDIF
-C
-C  retour aux mailles d'origine (passage des Tij aux Sij)
-C
-      IF(NUMK.GT.1) THEN
-C
-      DO 18 I2=1,NUMK
-C
-         DO 180 I=1,LONK
-C
-            I3=I2+(I-1)*NUMK
-            SM(I3,K,L)=SMNEW(I3)
-            ALF(I)=SMNEW(I3)/TM(I)
-            TM(I)=TM(I)-SMNEW(I3)
-C
-            ALFQ(I)=ALF(I)*ALF(I)
-            ALF1(I)=1.-ALF(I)
-            ALF1Q(I)=ALF1(I)*ALF1(I)
-            ALF2(I)=ALF1(I)-ALF(I)
-            ALF3(I)=ALF(I)*ALFQ(I)
-            ALF4(I)=ALF1(I)*ALF1Q(I)
-C
- 180     CONTINUE
-C
-         DO 181 JV=1,NTRA
-         DO 181 I=1,LONK
-C
-            I3=I2+(I-1)*NUMK
-            S0 (I3,K,L,JV)=ALF (I)* ( T0(I,JV)-ALF1(I)*
-     +              ( TX(I,JV)-ALF2(I)*TXX(I,JV) ) )
-            SSX (I3,K,L,JV)=ALFQ(I)*(TX(I,JV)-3.*ALF1(I)*TXX(I,JV))
-            SSXX(I3,K,L,JV)=ALF3(I)*TXX(I,JV)
-            SY (I3,K,L,JV)=ALF (I)*(TY(I,JV)-ALF1(I)*TXY(I,JV))
-            SZ (I3,K,L,JV)=ALF (I)*(TZ(I,JV)-ALF1(I)*TXZ(I,JV))
-            SSXY(I3,K,L,JV)=ALFQ(I)*TXY(I,JV)
-            SSXZ(I3,K,L,JV)=ALFQ(I)*TXZ(I,JV)
-            SYY(I3,K,L,JV)=ALF (I)*TYY(I,JV)
-            SYZ(I3,K,L,JV)=ALF (I)*TYZ(I,JV)
-            SZZ(I3,K,L,JV)=ALF (I)*TZZ(I,JV)
-C
-C   reajusts moments remaining in the box
-C
-            T0 (I,JV)=T0(I,JV)-S0(I3,K,L,JV)
-            TX (I,JV)=ALF1Q(I)*(TX(I,JV)+3.*ALF(I)*TXX(I,JV))
-            TXX(I,JV)=ALF4 (I)*TXX(I,JV)
-            TY (I,JV)=TY (I,JV)-SY (I3,K,L,JV)
-            TZ (I,JV)=TZ (I,JV)-SZ (I3,K,L,JV)
-            TYY(I,JV)=TYY(I,JV)-SYY(I3,K,L,JV)
-            TYZ(I,JV)=TYZ(I,JV)-SYZ(I3,K,L,JV)
-            TZZ(I,JV)=TZZ(I,JV)-SZZ(I3,K,L,JV)
-            TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
-            TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
-C
- 181     CONTINUE
-C
- 18   CONTINUE
-C
-      ELSE
-C
-      DO 190 I=1,LON
-         SM(I,K,L)=TM(I)
- 190  CONTINUE
-      DO 191 JV=1,NTRA
-      DO 1910 I=1,LON
-         S0 (I,K,L,JV)=T0 (I,JV)
-         SSX (I,K,L,JV)=TX (I,JV)
-         SY (I,K,L,JV)=TY (I,JV)
-         SZ (I,K,L,JV)=TZ (I,JV)
-         SSXX(I,K,L,JV)=TXX(I,JV)
-         SSXY(I,K,L,JV)=TXY(I,JV)
-         SSXZ(I,K,L,JV)=TXZ(I,JV)
-         SYY(I,K,L,JV)=TYY(I,JV)
-         SYZ(I,K,L,JV)=TYZ(I,JV)
-         SZZ(I,K,L,JV)=TZZ(I,JV)
- 1910 CONTINUE
- 191  CONTINUE
-C
-      ENDIF
-C
- 1    CONTINUE
-C
-C ----------- AA Test en fin de ADVX ------ Controle des S*
-
-c      DO 9999 l = 1, llm
-c      DO 9999 j = 1, jjp1
-c      DO 9999 i = 1, iip1
-c	   IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
-c           PRINT*, '-------------------'
-c	        PRINT*, 'En fin de ADVXP'
-c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
-c	        print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
-c           print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
-c       	print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
-c            WRITE (*,*) 'On arrete !! - pbl en fin de ADVXP'
-c            STOP
-c           ENDIF
-c 9999 CONTINUE
-c ---------- bouclage cyclique
-
-      DO l = 1,llm
-      DO j = 1,jjp1
-         SM(iip1,j,l) = SM(1,j,l)
-         S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
-     	 SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
-    	 SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
-    	 SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
-      END DO
-      END DO
-
-C ----------- qqtite totale de traceur dans tte l'atmosphere
-      DO l = 1, llm
-      DO j = 1, jjp1
-      DO i = 1, iim
-        sqf = sqf + S0(i,j,l,ntra)
-      END DO
-      END DO
-      END DO
-
-      PRINT*,'------ DIAG DANS ADVX2 - SORTIE -----'
-      PRINT*,'sqf=',sqf
-c-------------------------------------------------------------
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/advy.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advy.F	(revision 1910)
+++ 	(revision )
@@ -1,422 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE advy(limit,dty,pbarv,sm,s0,sx,sy,sz)
-      IMPLICIT NONE
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                C
-C  first-order moments (SOM) advection of tracer in Y direction  C
-C                                                                C
-C  Source : Pascal Simon ( Meteo, CNRM )			 C
-C  Adaptation : A.A. (LGGE) 					 C
-C  Derniere Modif : 15/12/94 LAST
-C								 C
-C  sont les arguments d'entree pour le s-pg			 C
-C								 C
-C  argument de sortie du s-pg					 C
-C								 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C  Rem : Probleme aux poles il faut reecrire ce cas specifique
-C        Attention au sens de l'indexation 
-C
-C  parametres principaux du modele
-C
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
- 
-C  Arguments :
-C  ----------
-C  dty : frequence fictive d'appel du transport
-C  parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
-
-      INTEGER lon,lat,niv
-      INTEGER i,j,jv,k,kp,l
-      INTEGER ntra
-      PARAMETER (ntra = 1)
-
-      REAL dty
-      REAL pbarv ( iip1,jjm, llm )
-
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C
-      REAL SM(iip1,jjp1,llm)
-     +    ,S0(iip1,jjp1,llm,ntra)
-      REAL sx(iip1,jjp1,llm,ntra)
-     +    ,sy(iip1,jjp1,llm,ntra)
-     +    ,sz(iip1,jjp1,llm,ntra)
-
-
-C  Local :
-C  ------- 
-
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-
-      REAL VGRI(iip1,0:jjp1,llm)
-
-C  Rem : UGRI et WGRI ne sont pas utilises dans 
-C  cette subroutine ( advection en y uniquement )
-C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
-C
-C  the moments F are similarly defined and used as temporary
-C  storage for portions of the grid boxes in transit
-C
-      REAL F0(iim,0:jjp1,ntra),FM(iim,0:jjp1)
-      REAL FX(iim,jjm,ntra),FY(iim,jjm,ntra)
-      REAL FZ(iim,jjm,ntra)
-      REAL S00(ntra)
-      REAL SM0             ! Just temporal variable
-C
-C  work arrays
-C
-      REAL ALF(iim,0:jjp1),ALF1(iim,0:jjp1)
-      REAL ALFQ(iim,0:jjp1),ALF1Q(iim,0:jjp1)
-      REAL TEMPTM          ! Just temporal variable
-c
-C  Special pour poles 
-c
-      REAL sbms,sfms,sfzs,sbmn,sfmn,sfzn
-      REAL sns0(ntra),snsz(ntra),snsm
-      REAL s1v(llm),slatv(llm)
-      REAL qy1(iim,llm,ntra),qylat(iim,llm,ntra)
-      REAL cx1(llm,ntra), cxLAT(llm,ntra)
-      REAL cy1(llm,ntra), cyLAT(llm,ntra)
-      REAL z1(iim), zcos(iim), zsin(iim)
-      real smpn,smps,s0pn,s0ps
-      REAL SSUM
-      EXTERNAL SSUM
-C
-      REAL sqi,sqf
-      LOGICAL LIMIT
-
-      lon = iim         ! rem : Il est possible qu'un pbl. arrive ici
-      lat = jjp1        ! a cause des dim. differentes entre les
-      niv=llm
-
-C
-C  the moments Fi are used as temporary storage for
-C  portions of the grid boxes in transit at the current level
-C
-C  work arrays
-C
-
-      DO l = 1,llm
-         DO j = 1,jjm
-            DO i = 1,iip1  
-            vgri (i,j,llm+1-l)=-1.*pbarv(i,j,l)  
-            enddo
-         enddo
-         do i=1,iip1
-             vgri(i,0,l) = 0.
-             vgri(i,jjp1,l) = 0.
-         enddo
-      enddo
-
-      DO 1 L=1,NIV
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 11
-C
-      DO 10 JV=1,NTRA
-      DO 10 K=1,LAT
-      DO 100 I=1,LON
-         sy(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
-     +                           ABS(sy(I,K,L,JV))),sy(I,K,L,JV))
- 100  CONTINUE
- 10   CONTINUE
-C
- 11   CONTINUE
-C
-C  le flux a travers le pole Nord est traite separement
-C
-      SM0=0.
-      DO 20 JV=1,NTRA
-         S00(JV)=0.
- 20   CONTINUE
-C
-      DO 21 I=1,LON
-C
-         IF(VGRI(I,0,L).LE.0.) THEN
-           FM(I,0)=-VGRI(I,0,L)*DTY
-           ALF(I,0)=FM(I,0)/SM(I,1,L)
-           SM(I,1,L)=SM(I,1,L)-FM(I,0)
-           SM0=SM0+FM(I,0)
-         ENDIF
-C
-         ALFQ(I,0)=ALF(I,0)*ALF(I,0)
-         ALF1(I,0)=1.-ALF(I,0)
-         ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
-C
- 21   CONTINUE
-C
-      DO 22 JV=1,NTRA
-      DO 220 I=1,LON
-C
-         IF(VGRI(I,0,L).LE.0.) THEN
-C
-           F0(I,0,JV)=ALF(I,0)*
-     +               ( S0(I,1,L,JV)-ALF1(I,0)*sy(I,1,L,JV) )
-C
-           S00(JV)=S00(JV)+F0(I,0,JV)
-           S0(I,1,L,JV)=S0(I,1,L,JV)-F0(I,0,JV)
-           sy(I,1,L,JV)=ALF1Q(I,0)*sy(I,1,L,JV)
-           sx(I,1,L,JV)=ALF1 (I,0)*sx(I,1,L,JV)
-           sz(I,1,L,JV)=ALF1 (I,0)*sz(I,1,L,JV)
-C
-         ENDIF
-C
- 220  CONTINUE
- 22   CONTINUE
-C
-      DO 23 I=1,LON
-         IF(VGRI(I,0,L).GT.0.) THEN
-           FM(I,0)=VGRI(I,0,L)*DTY
-           ALF(I,0)=FM(I,0)/SM0
-         ENDIF
- 23   CONTINUE
-C
-      DO 24 JV=1,NTRA
-      DO 240 I=1,LON
-         IF(VGRI(I,0,L).GT.0.) THEN
-           F0(I,0,JV)=ALF(I,0)*S00(JV)
-         ENDIF
- 240  CONTINUE
- 24   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 25 I=1,LON
-C
-         IF(VGRI(I,0,L).GT.0.) THEN
-           SM(I,1,L)=SM(I,1,L)+FM(I,0)
-           ALF(I,0)=FM(I,0)/SM(I,1,L)
-         ENDIF
-C
-         ALF1(I,0)=1.-ALF(I,0)
-C
- 25   CONTINUE
-C
-      DO 26 JV=1,NTRA
-      DO 260 I=1,LON
-C
-         IF(VGRI(I,0,L).GT.0.) THEN
-C
-         TEMPTM=ALF(I,0)*S0(I,1,L,JV)-ALF1(I,0)*F0(I,0,JV)
-         S0(I,1,L,JV)=S0(I,1,L,JV)+F0(I,0,JV)
-         sy(I,1,L,JV)=ALF1(I,0)*sy(I,1,L,JV)+3.*TEMPTM
-C
-         ENDIF
-C
- 260  CONTINUE
- 26   CONTINUE
-C
-C  calculate flux and moments between adjacent boxes
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-C  flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
-C
-      DO 30 K=1,LAT-1
-      KP=K+1
-      DO 300 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           FM(I,K)=-VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,KP,L)
-           SM(I,KP,L)=SM(I,KP,L)-FM(I,K)
-         ELSE
-           FM(I,K)=VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,K)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-C
- 300  CONTINUE
- 30   CONTINUE
-C
-      DO 31 JV=1,NTRA
-      DO 31 K=1,LAT-1
-      KP=K+1
-      DO 310 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-           F0(I,K,JV)=ALF (I,K)*
-     +                ( S0(I,KP,L,JV)-ALF1(I,K)*sy(I,KP,L,JV) )
-           FY(I,K,JV)=ALFQ(I,K)*sy(I,KP,L,JV)
-           FX(I,K,JV)=ALF (I,K)*sx(I,KP,L,JV)
-           FZ(I,K,JV)=ALF (I,K)*sz(I,KP,L,JV)
-C
-           S0(I,KP,L,JV)=S0(I,KP,L,JV)-F0(I,K,JV)
-           sy(I,KP,L,JV)=ALF1Q(I,K)*sy(I,KP,L,JV)
-           sx(I,KP,L,JV)=sx(I,KP,L,JV)-FX(I,K,JV)
-           sz(I,KP,L,JV)=sz(I,KP,L,JV)-FZ(I,K,JV)
-C
-         ELSE
-C
-           F0(I,K,JV)=ALF (I,K)*
-     +               ( S0(I,K,L,JV)+ALF1(I,K)*sy(I,K,L,JV) )
-           FY(I,K,JV)=ALFQ(I,K)*sy(I,K,L,JV)
-           FX(I,K,JV)=ALF(I,K)*sx(I,K,L,JV)
-           FZ(I,K,JV)=ALF(I,K)*sz(I,K,L,JV)
-C
-           S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,K,JV)
-           sy(I,K,L,JV)=ALF1Q(I,K)*sy(I,K,L,JV)
-           sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,K,JV)
-           sz(I,K,L,JV)=sz(I,K,L,JV)-FZ(I,K,JV)
-C
-         ENDIF
-C
- 310  CONTINUE
- 31   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 32 K=1,LAT-1
-      KP=K+1
-      DO 320 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-         ELSE
-           SM(I,KP,L)=SM(I,KP,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,KP,L)
-         ENDIF
-C
-         ALF1(I,K)=1.-ALF(I,K)
-C
- 320  CONTINUE
- 32   CONTINUE
-C
-      DO 33 JV=1,NTRA
-      DO 33 K=1,LAT-1
-      KP=K+1
-      DO 330 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
-         S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
-         sy(I,K,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*sy(I,K,L,JV)
-     +               +3.*TEMPTM
-         sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,K,JV)
-         sz(I,K,L,JV)=sz(I,K,L,JV)+FZ(I,K,JV)
-C
-         ELSE
-C
-         TEMPTM=ALF(I,K)*S0(I,KP,L,JV)-ALF1(I,K)*F0(I,K,JV)
-         S0(I,KP,L,JV)=S0(I,KP,L,JV)+F0(I,K,JV)
-         sy(I,KP,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*sy(I,KP,L,JV)
-     +                +3.*TEMPTM
-         sx(I,KP,L,JV)=sx(I,KP,L,JV)+FX(I,K,JV)
-         sz(I,KP,L,JV)=sz(I,KP,L,JV)+FZ(I,K,JV)
-C
-         ENDIF
-C
- 330  CONTINUE
- 33   CONTINUE
-C
-C  traitement special pour le pole Sud (idem pole Nord)
-C
-      K=LAT
-C
-      SM0=0.
-      DO 40 JV=1,NTRA
-         S00(JV)=0.
- 40   CONTINUE
-C
-      DO 41 I=1,LON
-C
-         IF(VGRI(I,K,L).GE.0.) THEN
-           FM(I,K)=VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,K)
-           SM0=SM0+FM(I,K)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-C
- 41   CONTINUE
-C
-      DO 42 JV=1,NTRA
-      DO 420 I=1,LON
-C
-         IF(VGRI(I,K,L).GE.0.) THEN
-           F0 (I,K,JV)=ALF(I,K)*
-     +                ( S0(I,K,L,JV)+ALF1(I,K)*sy(I,K,L,JV) )
-           S00(JV)=S00(JV)+F0(I,K,JV)
-C
-           S0(I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
-           sy(I,K,L,JV)=ALF1Q(I,K)*sy(I,K,L,JV)
-           sx(I,K,L,JV)=ALF1(I,K)*sx(I,K,L,JV)
-           sz(I,K,L,JV)=ALF1(I,K)*sz(I,K,L,JV)
-         ENDIF
-C
- 420  CONTINUE
- 42   CONTINUE
-C
-      DO 43 I=1,LON
-         IF(VGRI(I,K,L).LT.0.) THEN
-           FM(I,K)=-VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM0
-         ENDIF
- 43   CONTINUE
-C
-      DO 44 JV=1,NTRA
-      DO 440 I=1,LON
-         IF(VGRI(I,K,L).LT.0.) THEN
-           F0(I,K,JV)=ALF(I,K)*S00(JV)
-         ENDIF
- 440  CONTINUE
- 44   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 45 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-         ENDIF
-C
-         ALF1(I,K)=1.-ALF(I,K)
-C
- 45   CONTINUE
-C
-      DO 46 JV=1,NTRA
-      DO 460 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
-         S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
-         sy(I,K,L,JV)=ALF1(I,K)*sy(I,K,L,JV)+3.*TEMPTM
-C
-         ENDIF
-C
- 460  CONTINUE
- 46   CONTINUE
-C
- 1    CONTINUE
-C
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/advyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advyp.F	(revision 1910)
+++ 	(revision )
@@ -1,653 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE ADVYP(LIMIT,DTY,PBARV,SM,S0,SSX,SY,SZ
-     .                 ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
-      IMPLICIT NONE
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                 C
-C  second-order moments (SOM) advection of tracer in Y direction  C
-C                                                                 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                C
-C  Source : Pascal Simon ( Meteo, CNRM )			 C
-C  Adaptation : A.A. (LGGE) 					 C
-C  Derniere Modif : 19/10/95 LAST
-C								 C
-C  sont les arguments d'entree pour le s-pg			 C
-C								 C
-C  argument de sortie du s-pg					 C
-C								 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C  Rem : Probleme aux poles il faut reecrire ce cas specifique
-C        Attention au sens de l'indexation 
-C
-C  parametres principaux du modele
-C
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
- 
-C  Arguments :
-C  ----------
-C  dty : frequence fictive d'appel du transport
-C  parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
-
-      INTEGER lon,lat,niv
-      INTEGER i,j,jv,k,kp,l
-      INTEGER ntra
-C      PARAMETER (ntra = 1)
-
-      REAL dty
-      REAL pbarv ( iip1,jjm, llm )
-
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C
-      REAL SM(iip1,jjp1,llm)
-     +    ,S0(iip1,jjp1,llm,ntra)
-      REAL SSX(iip1,jjp1,llm,ntra)
-     +    ,SY(iip1,jjp1,llm,ntra)
-     +    ,SZ(iip1,jjp1,llm,ntra)
-     +    ,SSXX(iip1,jjp1,llm,ntra)
-     +    ,SSXY(iip1,jjp1,llm,ntra)
-     +    ,SSXZ(iip1,jjp1,llm,ntra)
-     +    ,SYY(iip1,jjp1,llm,ntra)
-     +    ,SYZ(iip1,jjp1,llm,ntra)
-     +    ,SZZ(iip1,jjp1,llm,ntra)
-C
-C  Local :
-C  ------- 
-
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-
-      REAL VGRI(iip1,0:jjp1,llm)
-
-C  Rem : UGRI et WGRI ne sont pas utilises dans 
-C  cette subroutine ( advection en y uniquement )
-C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
-C
-C  the moments F are similarly defined and used as temporary
-C  storage for portions of the grid boxes in transit
-C
-C  the moments Fij are used as temporary storage for
-C  portions of the grid boxes in transit at the current level
-C
-C  work arrays
-C
-C
-      REAL F0(iim,0:jjp1,ntra),FM(iim,0:jjp1)
-      REAL FX(iim,jjm,ntra),FY(iim,jjm,ntra)
-      REAL FZ(iim,jjm,ntra)
-      REAL FXX(iim,jjm,ntra),FXY(iim,jjm,ntra)
-      REAL FXZ(iim,jjm,ntra),FYY(iim,jjm,ntra)
-      REAL FYZ(iim,jjm,ntra),FZZ(iim,jjm,ntra)
-      REAL S00(ntra)
-      REAL SM0             ! Just temporal variable
-C
-C  work arrays
-C
-      REAL ALF(iim,0:jjp1),ALF1(iim,0:jjp1)
-      REAL ALFQ(iim,0:jjp1),ALF1Q(iim,0:jjp1)
-      REAL ALF2(iim,0:jjp1),ALF3(iim,0:jjp1)
-      REAL ALF4(iim,0:jjp1)
-      REAL TEMPTM          ! Just temporal variable
-      REAL SLPMAX,S1MAX,S1NEW,S2NEW
-c
-C  Special pour poles 
-c
-      REAL sbms,sfms,sfzs,sbmn,sfmn,sfzn
-      REAL sns0(ntra),snsz(ntra),snsm
-      REAL qy1(iim,llm,ntra),qylat(iim,llm,ntra)
-      REAL cx1(llm,ntra), cxLAT(llm,ntra)
-      REAL cy1(llm,ntra), cyLAT(llm,ntra)
-      REAL z1(iim), zcos(iim), zsin(iim)
-      REAL SSUM
-      EXTERNAL SSUM
-C
-      REAL sqi,sqf
-      LOGICAL LIMIT
-
-      lon = iim         ! rem : Il est possible qu'un pbl. arrive ici
-      lat = jjp1        ! a cause des dim. differentes entre les
-      niv = llm         !       tab. S et VGRI 
-                    
-c-----------------------------------------------------------------
-C initialisations
-
-      sbms = 0.
-      sfms = 0.
-      sfzs = 0.
-      sbmn = 0.
-      sfmn = 0.
-      sfzn = 0.
-
-c-----------------------------------------------------------------
-C *** Test : diag de la qtite totale de traceur dans
-C            l'atmosphere avant l'advection en Y
-c 
-      sqi = 0.
-      sqf = 0.
-
-      DO l = 1,llm
-         DO j = 1,jjp1
-           DO i = 1,iim
-              sqi = sqi + S0(i,j,l,ntra)
-           END DO
-         END DO
-      END DO
-      PRINT*,'---------- DIAG DANS ADVY - ENTREE --------'
-      PRINT*,'sqi=',sqi
-
-c-----------------------------------------------------------------
-C  Interface : adaptation nouveau modele
-C  -------------------------------------
-C
-C  Conversion des flux de masses en kg
-C-AA 20/10/94  le signe -1 est necessaire car indexation opposee
-
-      DO 500 l = 1,llm
-         DO 500 j = 1,jjm
-            DO 500 i = 1,iip1  
-            vgri (i,j,llm+1-l)=-1.*pbarv (i,j,l)
-  500 CONTINUE
-
-CAA Initialisation de flux fictifs aux bords sup. des boites pol.
-
-      DO l = 1,llm
-         DO i = 1,iip1  
-             vgri(i,0,l) = 0.
-             vgri(i,jjp1,l) = 0.
-         ENDDO
-      ENDDO
-c
-c----------------- START HERE -----------------------
-C  boucle sur les niveaux
-C
-      DO 1 L=1,NIV
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 11
-C
-      DO 10 JV=1,NTRA
-      DO 10 K=1,LAT
-      DO 100 I=1,LON
-         IF(S0(I,K,L,JV).GT.0.) THEN
-           SLPMAX=AMAX1(S0(I,K,L,JV),0.)
-           S1MAX=1.5*SLPMAX
-           S1NEW=AMIN1(S1MAX,AMAX1(-S1MAX,SY(I,K,L,JV)))
-           S2NEW=AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
-     +                  AMAX1(ABS(S1NEW)-SLPMAX,SYY(I,K,L,JV)) )
-           SY (I,K,L,JV)=S1NEW
-           SYY(I,K,L,JV)=S2NEW
-       SSXY(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXY(I,K,L,JV)))
-       SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
-         ELSE
-           SY (I,K,L,JV)=0.
-           SYY(I,K,L,JV)=0.
-           SSXY(I,K,L,JV)=0.
-           SYZ(I,K,L,JV)=0.
-         ENDIF
- 100  CONTINUE
- 10   CONTINUE
-C
- 11   CONTINUE
-C
-C  le flux a travers le pole Nord est traite separement
-C
-      SM0=0.
-      DO 20 JV=1,NTRA
-         S00(JV)=0.
- 20   CONTINUE
-C
-      DO 21 I=1,LON
-C
-         IF(VGRI(I,0,L).LE.0.) THEN
-           FM(I,0)=-VGRI(I,0,L)*DTY
-           ALF(I,0)=FM(I,0)/SM(I,1,L)
-           SM(I,1,L)=SM(I,1,L)-FM(I,0)
-           SM0=SM0+FM(I,0)
-         ENDIF
-C
-         ALFQ(I,0)=ALF(I,0)*ALF(I,0)
-         ALF1(I,0)=1.-ALF(I,0)
-         ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
-         ALF2(I,0)=ALF1(I,0)-ALF(I,0)
-         ALF3(I,0)=ALF(I,0)*ALFQ(I,0)
-         ALF4(I,0)=ALF1(I,0)*ALF1Q(I,0)
-C
- 21   CONTINUE
-c     print*,'ADVYP 21'
-C
-      DO 22 JV=1,NTRA
-      DO 220 I=1,LON
-C
-         IF(VGRI(I,0,L).LE.0.) THEN
-C
-           F0(I,0,JV)=ALF(I,0)* ( S0(I,1,L,JV)-ALF1(I,0)*
-     +        ( SY(I,1,L,JV)-ALF2(I,0)*SYY(I,1,L,JV) ) )
-C
-           S00(JV)=S00(JV)+F0(I,0,JV)
-           S0 (I,1,L,JV)=S0(I,1,L,JV)-F0(I,0,JV)
-           SY (I,1,L,JV)=ALF1Q(I,0)*
-     +            (SY(I,1,L,JV)+3.*ALF(I,0)*SYY(I,1,L,JV))
-           SYY(I,1,L,JV)=ALF4 (I,0)*SYY(I,1,L,JV)
-           SSX (I,1,L,JV)=ALF1 (I,0)*
-     +            (SSX(I,1,L,JV)+ALF(I,0)*SSXY(I,1,L,JV) )
-           SZ (I,1,L,JV)=ALF1 (I,0)*
-     +            (SZ(I,1,L,JV)+ALF(I,0)*SSXZ(I,1,L,JV) )
-           SSXX(I,1,L,JV)=ALF1 (I,0)*SSXX(I,1,L,JV)
-           SSXZ(I,1,L,JV)=ALF1 (I,0)*SSXZ(I,1,L,JV)
-           SZZ(I,1,L,JV)=ALF1 (I,0)*SZZ(I,1,L,JV)
-           SSXY(I,1,L,JV)=ALF1Q(I,0)*SSXY(I,1,L,JV)
-           SYZ(I,1,L,JV)=ALF1Q(I,0)*SYZ(I,1,L,JV)
-C
-         ENDIF
-C
- 220  CONTINUE
- 22   CONTINUE
-C
-      DO 23 I=1,LON
-         IF(VGRI(I,0,L).GT.0.) THEN
-           FM(I,0)=VGRI(I,0,L)*DTY
-           ALF(I,0)=FM(I,0)/SM0
-         ENDIF
- 23   CONTINUE
-C
-      DO 24 JV=1,NTRA
-      DO 240 I=1,LON
-         IF(VGRI(I,0,L).GT.0.) THEN
-           F0(I,0,JV)=ALF(I,0)*S00(JV)
-         ENDIF
- 240  CONTINUE
- 24   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-c     print*,'av ADVYP 25'
-      DO 25 I=1,LON
-C
-         IF(VGRI(I,0,L).GT.0.) THEN
-           SM(I,1,L)=SM(I,1,L)+FM(I,0)
-           ALF(I,0)=FM(I,0)/SM(I,1,L)
-         ENDIF
-C
-         ALFQ(I,0)=ALF(I,0)*ALF(I,0)
-         ALF1(I,0)=1.-ALF(I,0)
-         ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
-         ALF2(I,0)=ALF1(I,0)-ALF(I,0)
-         ALF3(I,0)=ALF1(I,0)*ALF(I,0)
-C
- 25   CONTINUE
-c     print*,'av ADVYP 25'
-C
-      DO 26 JV=1,NTRA
-      DO 260 I=1,LON
-C
-         IF(VGRI(I,0,L).GT.0.) THEN
-C
-         TEMPTM=ALF(I,0)*S0(I,1,L,JV)-ALF1(I,0)*F0(I,0,JV)
-         S0 (I,1,L,JV)=S0(I,1,L,JV)+F0(I,0,JV)
-         SYY(I,1,L,JV)=ALF1Q(I,0)*SYY(I,1,L,JV)
-     +        +5.*( ALF3 (I,0)*SY (I,1,L,JV)-ALF2(I,0)*TEMPTM )
-         SY (I,1,L,JV)=ALF1 (I,0)*SY (I,1,L,JV)+3.*TEMPTM
-      SSXY(I,1,L,JV)=ALF1 (I,0)*SSXY(I,1,L,JV)+3.*ALF(I,0)*SSX(I,1,L,JV)
-      SYZ(I,1,L,JV)=ALF1 (I,0)*SYZ(I,1,L,JV)+3.*ALF(I,0)*SZ(I,1,L,JV)
-C
-         ENDIF
-C
- 260  CONTINUE
- 26   CONTINUE
-C
-C  calculate flux and moments between adjacent boxes
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-C  flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
-C
-c     print*,'av ADVYP 30'
-      DO 30 K=1,LAT-1
-      KP=K+1
-      DO 300 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           FM(I,K)=-VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,KP,L)
-           SM(I,KP,L)=SM(I,KP,L)-FM(I,K)
-         ELSE
-           FM(I,K)=VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,K)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-         ALF2(I,K)=ALF1(I,K)-ALF(I,K)
-         ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
-         ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
-C
- 300  CONTINUE
- 30   CONTINUE
-c     print*,'ap ADVYP 30'
-C
-      DO 31 JV=1,NTRA
-      DO 31 K=1,LAT-1
-      KP=K+1
-      DO 310 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-           F0 (I,K,JV)=ALF (I,K)* ( S0(I,KP,L,JV)-ALF1(I,K)*
-     +        ( SY(I,KP,L,JV)-ALF2(I,K)*SYY(I,KP,L,JV) ) )
-           FY (I,K,JV)=ALFQ(I,K)*
-     +                 (SY(I,KP,L,JV)-3.*ALF1(I,K)*SYY(I,KP,L,JV))
-           FYY(I,K,JV)=ALF3(I,K)*SYY(I,KP,L,JV)
-           FX (I,K,JV)=ALF (I,K)*
-     +                 (SSX(I,KP,L,JV)-ALF1(I,K)*SSXY(I,KP,L,JV))
-           FZ (I,K,JV)=ALF (I,K)*
-     +                 (SZ(I,KP,L,JV)-ALF1(I,K)*SYZ(I,KP,L,JV))
-           FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,KP,L,JV)
-           FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,KP,L,JV)
-           FXX(I,K,JV)=ALF (I,K)*SSXX(I,KP,L,JV)
-           FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,KP,L,JV)
-           FZZ(I,K,JV)=ALF (I,K)*SZZ(I,KP,L,JV)
-C
-           S0 (I,KP,L,JV)=S0(I,KP,L,JV)-F0(I,K,JV)
-           SY (I,KP,L,JV)=ALF1Q(I,K)*
-     +                 (SY(I,KP,L,JV)+3.*ALF(I,K)*SYY(I,KP,L,JV))
-           SYY(I,KP,L,JV)=ALF4(I,K)*SYY(I,KP,L,JV)
-           SSX (I,KP,L,JV)=SSX (I,KP,L,JV)-FX (I,K,JV)
-           SZ (I,KP,L,JV)=SZ (I,KP,L,JV)-FZ (I,K,JV)
-           SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)-FXX(I,K,JV)
-           SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)-FXZ(I,K,JV)
-           SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)-FZZ(I,K,JV)
-           SSXY(I,KP,L,JV)=ALF1Q(I,K)*SSXY(I,KP,L,JV)
-           SYZ(I,KP,L,JV)=ALF1Q(I,K)*SYZ(I,KP,L,JV)
-C
-         ELSE
-C
-           F0 (I,K,JV)=ALF (I,K)* ( S0(I,K,L,JV)+ALF1(I,K)*
-     +             ( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
-           FY (I,K,JV)=ALFQ(I,K)*
-     +                 (SY(I,K,L,JV)+3.*ALF1(I,K)*SYY(I,K,L,JV))
-           FYY(I,K,JV)=ALF3(I,K)*SYY(I,K,L,JV)
-      FX (I,K,JV)=ALF (I,K)*(SSX(I,K,L,JV)+ALF1(I,K)*SSXY(I,K,L,JV))
-      FZ (I,K,JV)=ALF (I,K)*(SZ(I,K,L,JV)+ALF1(I,K)*SYZ(I,K,L,JV))
-           FXY(I,K,JV)=ALFQ(I,K)*SSXY(I,K,L,JV)
-           FYZ(I,K,JV)=ALFQ(I,K)*SYZ(I,K,L,JV)
-           FXX(I,K,JV)=ALF (I,K)*SSXX(I,K,L,JV)
-           FXZ(I,K,JV)=ALF (I,K)*SSXZ(I,K,L,JV)
-           FZZ(I,K,JV)=ALF (I,K)*SZZ(I,K,L,JV)
-C
-           S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
-           SY (I,K,L,JV)=ALF1Q(I,K)*
-     +                  (SY(I,K,L,JV)-3.*ALF(I,K)*SYY(I,K,L,JV))
-           SYY(I,K,L,JV)=ALF4(I,K)*SYY(I,K,L,JV)
-           SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,K,JV)
-           SZ (I,K,L,JV)=SZ (I,K,L,JV)-FZ (I,K,JV)
-           SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,K,JV)
-           SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)-FXZ(I,K,JV)
-           SZZ(I,K,L,JV)=SZZ(I,K,L,JV)-FZZ(I,K,JV)
-           SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
-           SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
-C
-         ENDIF
-C
- 310  CONTINUE
- 31   CONTINUE
-c     print*,'ap ADVYP 31'
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 32 K=1,LAT-1
-      KP=K+1
-      DO 320 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-         ELSE
-           SM(I,KP,L)=SM(I,KP,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,KP,L)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-         ALF2(I,K)=ALF1(I,K)-ALF(I,K)
-         ALF3(I,K)=ALF1(I,K)*ALF(I,K)
-C
- 320  CONTINUE
- 32   CONTINUE
-c     print*,'ap ADVYP 32'
-C
-      DO 33 JV=1,NTRA
-      DO 33 K=1,LAT-1
-      KP=K+1
-      DO 330 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
-         S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
-       SYY(I,K,L,JV)=ALFQ(I,K)*FYY(I,K,JV)+ALF1Q(I,K)*SYY(I,K,L,JV)
-     +  +5.*( ALF3(I,K)*(FY(I,K,JV)-SY(I,K,L,JV))+ALF2(I,K)*TEMPTM )
-         SY (I,K,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*SY(I,K,L,JV)
-     +            +3.*TEMPTM
-       SSXY(I,K,L,JV)=ALF (I,K)*FXY(I,K,JV)+ALF1(I,K)*SSXY(I,K,L,JV)
-     +         +3.*(ALF1(I,K)*FX (I,K,JV)-ALF (I,K)*SSX (I,K,L,JV))
-       SYZ(I,K,L,JV)=ALF (I,K)*FYZ(I,K,JV)+ALF1(I,K)*SYZ(I,K,L,JV)
-     +         +3.*(ALF1(I,K)*FZ (I,K,JV)-ALF (I,K)*SZ (I,K,L,JV))
-         SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,K,JV)
-         SZ (I,K,L,JV)=SZ (I,K,L,JV)+FZ (I,K,JV)
-         SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,K,JV)
-         SSXZ(I,K,L,JV)=SSXZ(I,K,L,JV)+FXZ(I,K,JV)
-         SZZ(I,K,L,JV)=SZZ(I,K,L,JV)+FZZ(I,K,JV)
-C
-         ELSE
-C
-         TEMPTM=ALF(I,K)*S0(I,KP,L,JV)-ALF1(I,K)*F0(I,K,JV)
-         S0 (I,KP,L,JV)=S0(I,KP,L,JV)+F0(I,K,JV)
-       SYY(I,KP,L,JV)=ALFQ(I,K)*FYY(I,K,JV)+ALF1Q(I,K)*SYY(I,KP,L,JV)
-     +  +5.*( ALF3(I,K)*(SY(I,KP,L,JV)-FY(I,K,JV))-ALF2(I,K)*TEMPTM )
-         SY (I,KP,L,JV)=ALF(I,K)*FY(I,K,JV)+ALF1(I,K)*SY(I,KP,L,JV)
-     +                 +3.*TEMPTM
-       SSXY(I,KP,L,JV)=ALF(I,K)*FXY(I,K,JV)+ALF1(I,K)*SSXY(I,KP,L,JV)
-     +             +3.*(ALF(I,K)*SSX(I,KP,L,JV)-ALF1(I,K)*FX(I,K,JV))
-         SYZ(I,KP,L,JV)=ALF(I,K)*FYZ(I,K,JV)+ALF1(I,K)*SYZ(I,KP,L,JV)
-     +             +3.*(ALF(I,K)*SZ(I,KP,L,JV)-ALF1(I,K)*FZ(I,K,JV))
-         SSX (I,KP,L,JV)=SSX (I,KP,L,JV)+FX (I,K,JV)
-         SZ (I,KP,L,JV)=SZ (I,KP,L,JV)+FZ (I,K,JV)
-         SSXX(I,KP,L,JV)=SSXX(I,KP,L,JV)+FXX(I,K,JV)
-         SSXZ(I,KP,L,JV)=SSXZ(I,KP,L,JV)+FXZ(I,K,JV)
-         SZZ(I,KP,L,JV)=SZZ(I,KP,L,JV)+FZZ(I,K,JV)
-C
-         ENDIF
-C
- 330  CONTINUE
- 33   CONTINUE
-c     print*,'ap ADVYP 33'
-C
-C  traitement special pour le pole Sud (idem pole Nord)
-C
-      K=LAT
-C
-      SM0=0.
-      DO 40 JV=1,NTRA
-         S00(JV)=0.
- 40   CONTINUE
-C
-      DO 41 I=1,LON
-C
-         IF(VGRI(I,K,L).GE.0.) THEN
-           FM(I,K)=VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,K)
-           SM0=SM0+FM(I,K)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-         ALF2(I,K)=ALF1(I,K)-ALF(I,K)
-         ALF3(I,K)=ALF(I,K)*ALFQ(I,K)
-         ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
-C
- 41   CONTINUE
-c     print*,'ap ADVYP 41'
-C
-      DO 42 JV=1,NTRA
-      DO 420 I=1,LON
-C
-         IF(VGRI(I,K,L).GE.0.) THEN
-           F0 (I,K,JV)=ALF(I,K)* ( S0(I,K,L,JV)+ALF1(I,K)*
-     +             ( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
-           S00(JV)=S00(JV)+F0(I,K,JV)
-C
-           S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0 (I,K,JV)
-           SY (I,K,L,JV)=ALF1Q(I,K)*
-     +                  (SY(I,K,L,JV)-3.*ALF(I,K)*SYY(I,K,L,JV))
-           SYY(I,K,L,JV)=ALF4 (I,K)*SYY(I,K,L,JV)
-      SSX (I,K,L,JV)=ALF1(I,K)*(SSX(I,K,L,JV)-ALF(I,K)*SSXY(I,K,L,JV))
-      SZ (I,K,L,JV)=ALF1(I,K)*(SZ(I,K,L,JV)-ALF(I,K)*SYZ(I,K,L,JV))
-           SSXX(I,K,L,JV)=ALF1 (I,K)*SSXX(I,K,L,JV)
-           SSXZ(I,K,L,JV)=ALF1 (I,K)*SSXZ(I,K,L,JV)
-           SZZ(I,K,L,JV)=ALF1 (I,K)*SZZ(I,K,L,JV)
-           SSXY(I,K,L,JV)=ALF1Q(I,K)*SSXY(I,K,L,JV)
-           SYZ(I,K,L,JV)=ALF1Q(I,K)*SYZ(I,K,L,JV)
-         ENDIF
-C
- 420  CONTINUE
- 42   CONTINUE
-c     print*,'ap ADVYP 42'
-C
-      DO 43 I=1,LON
-         IF(VGRI(I,K,L).LT.0.) THEN
-           FM(I,K)=-VGRI(I,K,L)*DTY
-           ALF(I,K)=FM(I,K)/SM0
-         ENDIF
- 43   CONTINUE
-c     print*,'ap ADVYP 43'
-C
-      DO 44 JV=1,NTRA
-      DO 440 I=1,LON
-         IF(VGRI(I,K,L).LT.0.) THEN
-           F0(I,K,JV)=ALF(I,K)*S00(JV)
-         ENDIF
- 440  CONTINUE
- 44   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 45 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,K)
-           ALF(I,K)=FM(I,K)/SM(I,K,L)
-         ENDIF
-C
-         ALFQ(I,K)=ALF(I,K)*ALF(I,K)
-         ALF1(I,K)=1.-ALF(I,K)
-         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
-         ALF2(I,K)=ALF1(I,K)-ALF(I,K)
-         ALF3(I,K)=ALF1(I,K)*ALF(I,K)
-C
- 45   CONTINUE
-c     print*,'ap ADVYP 45'
-C
-      DO 46 JV=1,NTRA
-      DO 460 I=1,LON
-C
-         IF(VGRI(I,K,L).LT.0.) THEN
-C
-         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
-         S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,K,JV)
-         SYY(I,K,L,JV)=ALF1Q(I,K)*SYY(I,K,L,JV)
-     +           +5.*(-ALF3 (I,K)*SY (I,K,L,JV)+ALF2(I,K)*TEMPTM )
-         SY (I,K,L,JV)=ALF1(I,K)*SY (I,K,L,JV)+3.*TEMPTM
-      SSXY(I,K,L,JV)=ALF1(I,K)*SSXY(I,K,L,JV)-3.*ALF(I,K)*SSX(I,K,L,JV)
-      SYZ(I,K,L,JV)=ALF1(I,K)*SYZ(I,K,L,JV)-3.*ALF(I,K)*SZ(I,K,L,JV)
-C
-         ENDIF
-C
- 460  CONTINUE
- 46   CONTINUE
-c     print*,'ap ADVYP 46'
-C
- 1    CONTINUE
-
-c--------------------------------------------------
-C     bouclage cyclique horizontal .
-     
-      DO l = 1,llm
-         DO jv = 1,ntra
-            DO j = 1,jjp1
-               SM(iip1,j,l) = SM(1,j,l)
-               S0(iip1,j,l,jv) = S0(1,j,l,jv)
-               SSX(iip1,j,l,jv) = SSX(1,j,l,jv)   
-               SY(iip1,j,l,jv) = SY(1,j,l,jv)
-               SZ(iip1,j,l,jv) = SZ(1,j,l,jv)
-            END DO
-         END DO
-      END DO
-
-c -------------------------------------------------------------------
-C *** Test  negativite:
-
-c      DO jv = 1,ntra
-c       DO l = 1,llm
-c         DO j = 1,jjp1
-c           DO i = 1,iip1
-c              IF (s0( i,j,l,jv ).lt.0.) THEN
-c                 PRINT*, '------ S0 < 0 en FIN ADVYP ---'
-c                 PRINT*, 'S0(',i,j,l,jv,')=', S0(i,j,l,jv)
-cc                 STOP
-c              ENDIF
-c           ENDDO
-c         ENDDO
-c       ENDDO
-c      ENDDO
- 
-   
-c -------------------------------------------------------------------
-C *** Test : diag de la qtite totale de traceur dans
-C            l'atmosphere avant l'advection en Y
- 
-       DO l = 1,llm
-         DO j = 1,jjp1
-           DO i = 1,iim
-              sqf = sqf + S0(i,j,l,ntra)
-           END DO
-         END DO
-       END DO
-      PRINT*,'---------- DIAG DANS ADVY - SORTIE --------'
-      PRINT*,'sqf=',sqf
-c     print*,'ap ADVYP fin'
-
-c-----------------------------------------------------------------
-C
-      RETURN
-      END
-
-
-
-
-
-
-
-
-
-
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/advz.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advz.F	(revision 1910)
+++ 	(revision )
@@ -1,320 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE advz(limit,dtz,w,sm,s0,sx,sy,sz)
-      IMPLICIT NONE
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                C
-C  first-order moments (FOM) advection of tracer in Z direction  C
-C                                                                C
-C  Source : Pascal Simon (Meteo,CNRM)                            C
-C  Adaptation : A.Armengaud (LGGE) juin 94                       C
-C                                                                C
-C                                                                C
-C  sont des arguments d'entree pour le s-pg...                   C
-C                                                                C
-C  dq est l'argument de sortie pour le s-pg                      C
-C								 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C  parametres principaux du modele
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-
-C    #include "traceur.h"
-
-C  Arguments :
-C  -----------
-C  dtz : frequence fictive d'appel du transport 
-C  w : flux de masse en z en Pa.m2.s-1
-
-      INTEGER ntra
-      PARAMETER (ntra = 1)
-
-      REAL dtz
-      REAL w ( iip1,jjp1,llm )
-    
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C
-      REAL SM(iip1,jjp1,llm)
-     +    ,S0(iip1,jjp1,llm,ntra)
-      REAL sx(iip1,jjp1,llm,ntra)
-     +    ,sy(iip1,jjp1,llm,ntra)
-     +    ,sz(iip1,jjp1,llm,ntra)
-
-
-C  Local :
-C  ------- 
-
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-
-      REAL WGRI(iip1,jjp1,0:llm)
-
-C
-C  the moments F are used as temporary  storage for 
-C  portions of grid boxes in transit at the current latitude
-C
-      REAL FM(iim,llm)
-      REAL F0(iim,llm,ntra),FX(iim,llm,ntra)
-      REAL FY(iim,llm,ntra),FZ(iim,llm,ntra)
-C
-C  work arrays
-C
-      REAL ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
-      REAL TEMPTM            ! Just temporal variable
-      REAL sqi,sqf
-C
-      LOGICAL LIMIT
-      INTEGER lon,lat,niv
-      INTEGER i,j,jv,k,l,lp
-
-      lon = iim
-      lat = jjp1
-      niv = llm 
-
-C *** Test de passage d'arguments ******
- 
-c     DO 399 l = 1, llm
-c     DO 399 j = 1, jjp1
-c     DO 399 i = 1, iip1
-c        IF (S0(i,j,l,ntra) .lt. 0. ) THEN
-c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
-c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
-c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
-c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
-c           PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
-c            STOP
-c        ENDIF
-  399 CONTINUE
-
-C-----------------------------------------------------------------
-C *** Test : diag de la qqtite totale de traceur 
-C            dans l'atmosphere avant l'advection en z
-      sqi = 0.
-      sqf = 0.
-
-      DO l = 1,llm
-         DO j = 1,jjp1
-            DO i = 1,iim
-               sqi = sqi + S0(i,j,l,ntra)
-            ENDDO
-         ENDDO
-      ENDDO
-      PRINT*,'-------- DIAG DANS ADVZ - ENTREE ---------'
-      PRINT*,'sqi=',sqi
-
-C-----------------------------------------------------------------
-C  Interface : adaptation nouveau modele
-C  -------------------------------------
-C
-C  Conversion du flux de masse en kg.s-1
-
-      DO 500 l = 1,llm
-         DO 500 j = 1,jjp1
-            DO 500 i = 1,iip1  
-c            wgri (i,j,llm+1-l) =  w (i,j,l) / g 
-               wgri (i,j,llm+1-l) =  w (i,j,l) 
-c             wgri (i,j,0) = 0.                ! a detruire ult.
-c             wgri (i,j,l) = 0.1               !    w (i,j,l) 
-c             wgri (i,j,llm) = 0.              ! a detruire ult.
-  500 CONTINUE
-         DO  j = 1,jjp1
-            DO i = 1,iip1  
-               wgri(i,j,0)=0.
-            enddo
-         enddo
-
-C-----------------------------------------------------------------
-  
-C  start here          
-C  boucle sur les latitudes
-C
-      DO 1 K=1,LAT
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 101
-C
-      DO 10 JV=1,NTRA
-      DO 10 L=1,NIV
-         DO 100 I=1,LON
-            sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
-     +                              ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
- 100     CONTINUE
- 10   CONTINUE
-C
- 101  CONTINUE
-C
-C  boucle sur les niveaux intercouches de 1 a NIV-1
-C   (flux nul au sommet L=0 et a la base L=NIV)
-C
-C  calculate flux and moments between adjacent boxes
-C     (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-      DO 11 L=1,NIV-1
-      LP=L+1
-C
-      DO 110 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-           FM(I,L)=-WGRI(I,K,L)*DTZ
-           ALF(I)=FM(I,L)/SM(I,K,LP)
-           SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
-         ELSE
-           FM(I,L)=WGRI(I,K,L)*DTZ
-           ALF(I)=FM(I,L)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,L)
-         ENDIF
-C
-         ALFQ (I)=ALF(I)*ALF(I)
-         ALF1 (I)=1.-ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-C
- 110  CONTINUE
-C
-      DO 111 JV=1,NTRA
-      DO 1110 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-C
-           F0(I,L,JV)=ALF (I)*( S0(I,K,LP,JV)-ALF1(I)*sz(I,K,LP,JV) )
-           FZ(I,L,JV)=ALFQ(I)*sz(I,K,LP,JV)
-           FX(I,L,JV)=ALF (I)*sx(I,K,LP,JV)
-           FY(I,L,JV)=ALF (I)*sy(I,K,LP,JV)
-C
-           S0(I,K,LP,JV)=S0(I,K,LP,JV)-F0(I,L,JV)
-           sz(I,K,LP,JV)=ALF1Q(I)*sz(I,K,LP,JV)
-           sx(I,K,LP,JV)=sx(I,K,LP,JV)-FX(I,L,JV)
-           sy(I,K,LP,JV)=sy(I,K,LP,JV)-FY(I,L,JV)
-C
-         ELSE
-C
-           F0(I,L,JV)=ALF (I)*(S0(I,K,L,JV)+ALF1(I)*sz(I,K,L,JV) )
-           FZ(I,L,JV)=ALFQ(I)*sz(I,K,L,JV)
-           FX(I,L,JV)=ALF (I)*sx(I,K,L,JV)
-           FY(I,L,JV)=ALF (I)*sy(I,K,L,JV)
-C
-           S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,L,JV)
-           sz(I,K,L,JV)=ALF1Q(I)*sz(I,K,L,JV)
-           sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,L,JV)
-           sy(I,K,L,JV)=sy(I,K,L,JV)-FY(I,L,JV)
-C
-         ENDIF
-C
- 1110 CONTINUE
- 111  CONTINUE
-C
- 11   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 12 L=1,NIV-1
-      LP=L+1
-C
-      DO 120 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,L)
-           ALF(I)=FM(I,L)/SM(I,K,L)
-         ELSE
-           SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
-           ALF(I)=FM(I,L)/SM(I,K,LP)
-         ENDIF
-C
-         ALF1(I)=1.-ALF(I)
-         ALFQ(I)=ALF(I)*ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-C
- 120  CONTINUE
-C
-      DO 121 JV=1,NTRA
-      DO 1210 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-C
-           TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
-           S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
-           sz(I,K,L,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,L,JV)+3.*TEMPTM
-           sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,L,JV)
-           sy(I,K,L,JV)=sy(I,K,L,JV)+FY(I,L,JV)
-C
-         ELSE
-C
-           TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
-           S0(I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
-           sz(I,K,LP,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,LP,JV)
-     +                  +3.*TEMPTM
-           sx(I,K,LP,JV)=sx(I,K,LP,JV)+FX(I,L,JV)
-           sy(I,K,LP,JV)=sy(I,K,LP,JV)+FY(I,L,JV)
-C
-         ENDIF
-C
- 1210 CONTINUE
- 121  CONTINUE
-C
- 12   CONTINUE
-C
-C  fin de la boucle principale sur les latitudes
-C
- 1    CONTINUE
-C
-C-------------------------------------------------------------
-C
-C ----------- AA Test en fin de ADVX ------ Controle des S*
-
-c     DO 9999 l = 1, llm
-c     DO 9999 j = 1, jjp1
-c     DO 9999 i = 1, iip1
-c        IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN 
-c           PRINT*, '-------------------'
-c           PRINT*, 'En fin de ADVZ'
-c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
-c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
-c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
-c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
-c           WRITE (*,*) 'On arrete !! - pbl en fin de ADVZ1'
-c            STOP
-c        ENDIF
- 9999 CONTINUE
-
-C *** ------------------- bouclage cyclique  en X ------------
-      
-c      DO l = 1,llm
-c         DO j = 1,jjp1
-c            SM(iip1,j,l) = SM(1,j,l)
-c            S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
-C            sx(iip1,j,l,ntra) = sx(1,j,l,ntra)
-c            sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
-c            sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
-c         ENDDO
-c      ENDDO
-           
-C-------------------------------------------------------------
-C *** Test : diag de la qqtite totale de traceur 
-C            dans l'atmosphere avant l'advection en z
-      DO l = 1,llm
-         DO j = 1,jjp1
-            DO i = 1,iim
-               sqf = sqf + S0(i,j,l,ntra)
-            ENDDO
-         ENDDO
-      ENDDO
-      PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
-      PRINT*,'sqf=', sqf
-
-C-------------------------------------------------------------
-      RETURN
-      END
-C_______________________________________________________________
-C_______________________________________________________________
Index: LMDZ5/branches/testing/libf/dyn3dmem/advzp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/advzp.F	(revision 1910)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE ADVZP(LIMIT,DTZ,W,SM,S0,SSX,SY,SZ
-     .                 ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra )
-
-      IMPLICIT NONE
-
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                 C
-C  second-order moments (SOM) advection of tracer in Z direction  C
-C                                                                 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C                                                                 C
-C  Source : Pascal Simon ( Meteo, CNRM )                          C
-C  Adaptation : A.A. (LGGE)                                       C
-C  Derniere Modif : 19/11/95 LAST                                 C
-C                                                                 C
-C  sont les arguments d'entree pour le s-pg                       C
-C                                                                 C
-C  argument de sortie du s-pg                                     C
-C                                                                 C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Rem : Probleme aux poles il faut reecrire ce cas specifique
-C        Attention au sens de l'indexation
-C
-
-C
-C  parametres principaux du modele
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-C
-C  Arguments :
-C  ----------
-C  dty : frequence fictive d'appel du transport
-C  parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
-c
-        INTEGER lon,lat,niv
-        INTEGER i,j,jv,k,kp,l,lp
-        INTEGER ntra
-c        PARAMETER (ntra = 1)
-c
-        REAL dtz
-        REAL w ( iip1,jjp1,llm )
-c
-C  moments: SM  total mass in each grid box
-C           S0  mass of tracer in each grid box
-C           Si  1rst order moment in i direction
-C
-      REAL SM(iip1,jjp1,llm)
-     +    ,S0(iip1,jjp1,llm,ntra)
-      REAL SSX(iip1,jjp1,llm,ntra)
-     +    ,SY(iip1,jjp1,llm,ntra)
-     +    ,SZ(iip1,jjp1,llm,ntra)
-     +    ,SSXX(iip1,jjp1,llm,ntra)
-     +    ,SSXY(iip1,jjp1,llm,ntra)
-     +    ,SSXZ(iip1,jjp1,llm,ntra)
-     +    ,SYY(iip1,jjp1,llm,ntra)
-     +    ,SYZ(iip1,jjp1,llm,ntra)
-     +    ,SZZ(iip1,jjp1,llm,ntra)
-C
-C  Local :
-C  -------
-C
-C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
-C  mass fluxes in kg
-C  declaration :
-C
-      REAL WGRI(iip1,jjp1,0:llm)
-
-C Rem : UGRI et VGRI ne sont pas utilises dans
-C  cette subroutine ( advection en z uniquement )
-C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
-C         attention a celui de WGRI
-C
-C  the moments F are similarly defined and used as temporary
-C  storage for portions of the grid boxes in transit
-C
-C  the moments Fij are used as temporary storage for
-C  portions of the grid boxes in transit at the current level
-C
-C  work arrays
-C
-C
-      REAL F0(iim,llm,ntra),FM(iim,llm)
-      REAL FX(iim,llm,ntra),FY(iim,llm,ntra)
-      REAL FZ(iim,llm,ntra)
-      REAL FXX(iim,llm,ntra),FXY(iim,llm,ntra)
-      REAL FXZ(iim,llm,ntra),FYY(iim,llm,ntra)
-      REAL FYZ(iim,llm,ntra),FZZ(iim,llm,ntra)
-      REAL S00(ntra)
-      REAL SM0             ! Just temporal variable
-C
-C  work arrays
-C
-      REAL ALF(iim),ALF1(iim)
-      REAL ALFQ(iim),ALF1Q(iim)
-      REAL ALF2(iim),ALF3(iim)
-      REAL ALF4(iim)
-      REAL TEMPTM          ! Just temporal variable
-      REAL SLPMAX,S1MAX,S1NEW,S2NEW
-c
-      REAL sqi,sqf
-      LOGICAL LIMIT
-
-      lon = iim         ! rem : Il est possible qu'un pbl. arrive ici
-      lat = jjp1        ! a cause des dim. differentes entre les
-      niv = llm         !       tab. S et VGRI 
-                    
-c-----------------------------------------------------------------
-C *** Test : diag de la qtite totale de traceur dans
-C            l'atmosphere avant l'advection en Y
-c 
-      sqi = 0.
-      sqf = 0.
-c
-      DO l = 1,llm
-         DO j = 1,jjp1
-           DO i = 1,iim
-              sqi = sqi + S0(i,j,l,ntra)
-           END DO
-         END DO
-      END DO
-      PRINT*,'---------- DIAG DANS ADVZP - ENTREE --------'
-      PRINT*,'sqi=',sqi
-
-c-----------------------------------------------------------------
-C  Interface : adaptation nouveau modele
-C  -------------------------------------
-C
-C  Conversion des flux de masses en kg
-
-      DO 500 l = 1,llm
-         DO 500 j = 1,jjp1
-            DO 500 i = 1,iip1  
-            wgri (i,j,llm+1-l) = w (i,j,l)  
-  500 CONTINUE
-      do j=1,jjp1
-         do i=1,iip1
-            wgri(i,j,0)=0.
-         enddo
-      enddo
-c
-cAA rem : Je ne suis pas sur du signe  
-cAA       Je ne suis pas sur pour le 0:llm
-c
-c-----------------------------------------------------------------
-C---------------------- START HERE -------------------------------
-C
-C  boucle sur les latitudes
-C
-      DO 1 K=1,LAT
-C
-C  place limits on appropriate moments before transport
-C      (if flux-limiting is to be applied)
-C
-      IF(.NOT.LIMIT) GO TO 101
-C
-      DO 10 JV=1,NTRA
-      DO 10 L=1,NIV
-         DO 100 I=1,LON
-            IF(S0(I,K,L,JV).GT.0.) THEN
-              SLPMAX=S0(I,K,L,JV)
-              S1MAX =1.5*SLPMAX
-              S1NEW =AMIN1(S1MAX,AMAX1(-S1MAX,SZ(I,K,L,JV)))
-              S2NEW =AMIN1( 2.*SLPMAX-ABS(S1NEW)/3. ,
-     +                     AMAX1(ABS(S1NEW)-SLPMAX,SZZ(I,K,L,JV)) )
-              SZ (I,K,L,JV)=S1NEW
-              SZZ(I,K,L,JV)=S2NEW
-              SSXZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SSXZ(I,K,L,JV)))
-              SYZ(I,K,L,JV)=AMIN1(SLPMAX,AMAX1(-SLPMAX,SYZ(I,K,L,JV)))
-            ELSE
-              SZ (I,K,L,JV)=0.
-              SZZ(I,K,L,JV)=0.
-              SSXZ(I,K,L,JV)=0.
-              SYZ(I,K,L,JV)=0.
-            ENDIF
- 100     CONTINUE
- 10   CONTINUE
-C
- 101  CONTINUE
-C
-C  boucle sur les niveaux intercouches de 1 a NIV-1
-C   (flux nul au sommet L=0 et a la base L=NIV)
-C
-C  calculate flux and moments between adjacent boxes
-C     (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
-C  1- create temporary moments/masses for partial boxes in transit
-C  2- reajusts moments remaining in the box
-C
-      DO 11 L=1,NIV-1
-      LP=L+1
-C
-      DO 110 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-           FM(I,L)=-WGRI(I,K,L)*DTZ
-           ALF(I)=FM(I,L)/SM(I,K,LP)
-           SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
-         ELSE
-           FM(I,L)=WGRI(I,K,L)*DTZ
-           ALF(I)=FM(I,L)/SM(I,K,L)
-           SM(I,K,L)=SM(I,K,L)-FM(I,L)
-         ENDIF
-C
-         ALFQ (I)=ALF(I)*ALF(I)
-         ALF1 (I)=1.-ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-         ALF2 (I)=ALF1(I)-ALF(I)
-         ALF3 (I)=ALF(I)*ALFQ(I)
-         ALF4 (I)=ALF1(I)*ALF1Q(I)
-C
- 110  CONTINUE
-C
-      DO 111 JV=1,NTRA
-      DO 1110 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-C
-           F0 (I,L,JV)=ALF (I)* ( S0(I,K,LP,JV)-ALF1(I)*
-     +          ( SZ(I,K,LP,JV)-ALF2(I)*SZZ(I,K,LP,JV) ) )
-           FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,LP,JV)-3.*ALF1(I)*SZZ(I,K,LP,JV))
-           FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,LP,JV)
-           FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,LP,JV)
-           FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,LP,JV)
-           FX (I,L,JV)=ALF (I)*(SSX(I,K,LP,JV)-ALF1(I)*SSXZ(I,K,LP,JV))
-           FY (I,L,JV)=ALF (I)*(SY(I,K,LP,JV)-ALF1(I)*SYZ(I,K,LP,JV))
-           FXX(I,L,JV)=ALF (I)*SSXX(I,K,LP,JV)
-           FXY(I,L,JV)=ALF (I)*SSXY(I,K,LP,JV)
-           FYY(I,L,JV)=ALF (I)*SYY(I,K,LP,JV)
-C
-           S0 (I,K,LP,JV)=S0 (I,K,LP,JV)-F0 (I,L,JV)
-           SZ (I,K,LP,JV)=ALF1Q(I)
-     +                   *(SZ(I,K,LP,JV)+3.*ALF(I)*SZZ(I,K,LP,JV))
-           SZZ(I,K,LP,JV)=ALF4 (I)*SZZ(I,K,LP,JV)
-           SSXZ(I,K,LP,JV)=ALF1Q(I)*SSXZ(I,K,LP,JV)
-           SYZ(I,K,LP,JV)=ALF1Q(I)*SYZ(I,K,LP,JV)
-           SSX (I,K,LP,JV)=SSX (I,K,LP,JV)-FX (I,L,JV)
-           SY (I,K,LP,JV)=SY (I,K,LP,JV)-FY (I,L,JV)
-           SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)-FXX(I,L,JV)
-           SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)-FXY(I,L,JV)
-           SYY(I,K,LP,JV)=SYY(I,K,LP,JV)-FYY(I,L,JV)
-C
-         ELSE
-C
-           F0 (I,L,JV)=ALF (I)*(S0(I,K,L,JV)
-     +           +ALF1(I) * (SZ(I,K,L,JV)+ALF2(I)*SZZ(I,K,L,JV)) )
-           FZ (I,L,JV)=ALFQ(I)*(SZ(I,K,L,JV)+3.*ALF1(I)*SZZ(I,K,L,JV))
-           FZZ(I,L,JV)=ALF3(I)*SZZ(I,K,L,JV)
-           FXZ(I,L,JV)=ALFQ(I)*SSXZ(I,K,L,JV)
-           FYZ(I,L,JV)=ALFQ(I)*SYZ(I,K,L,JV)
-           FX (I,L,JV)=ALF (I)*(SSX(I,K,L,JV)+ALF1(I)*SSXZ(I,K,L,JV))
-           FY (I,L,JV)=ALF (I)*(SY(I,K,L,JV)+ALF1(I)*SYZ(I,K,L,JV))
-           FXX(I,L,JV)=ALF (I)*SSXX(I,K,L,JV)
-           FXY(I,L,JV)=ALF (I)*SSXY(I,K,L,JV)
-           FYY(I,L,JV)=ALF (I)*SYY(I,K,L,JV)
-C
-           S0 (I,K,L,JV)=S0 (I,K,L,JV)-F0(I,L,JV)
-           SZ (I,K,L,JV)=ALF1Q(I)*(SZ(I,K,L,JV)-3.*ALF(I)*SZZ(I,K,L,JV))
-           SZZ(I,K,L,JV)=ALF4 (I)*SZZ(I,K,L,JV)
-           SSXZ(I,K,L,JV)=ALF1Q(I)*SSXZ(I,K,L,JV)
-           SYZ(I,K,L,JV)=ALF1Q(I)*SYZ(I,K,L,JV)
-           SSX (I,K,L,JV)=SSX (I,K,L,JV)-FX (I,L,JV)
-           SY (I,K,L,JV)=SY (I,K,L,JV)-FY (I,L,JV)
-           SSXX(I,K,L,JV)=SSXX(I,K,L,JV)-FXX(I,L,JV)
-           SSXY(I,K,L,JV)=SSXY(I,K,L,JV)-FXY(I,L,JV)
-           SYY(I,K,L,JV)=SYY(I,K,L,JV)-FYY(I,L,JV)
-C
-         ENDIF
-C
- 1110 CONTINUE
- 111  CONTINUE
-C
- 11   CONTINUE
-C
-C  puts the temporary moments Fi into appropriate neighboring boxes
-C
-      DO 12 L=1,NIV-1
-      LP=L+1
-C
-      DO 120 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-           SM(I,K,L)=SM(I,K,L)+FM(I,L)
-           ALF(I)=FM(I,L)/SM(I,K,L)
-         ELSE
-           SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
-           ALF(I)=FM(I,L)/SM(I,K,LP)
-         ENDIF
-C
-         ALF1(I)=1.-ALF(I)
-         ALFQ(I)=ALF(I)*ALF(I)
-         ALF1Q(I)=ALF1(I)*ALF1(I)
-         ALF2(I)=ALF(I)*ALF1(I)
-         ALF3(I)=ALF1(I)-ALF(I)
-C
- 120  CONTINUE
-C
-      DO 121 JV=1,NTRA
-      DO 1210 I=1,LON
-C
-         IF(WGRI(I,K,L).LT.0.) THEN
-C
-           TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
-           S0 (I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
-           SZZ(I,K,L,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,L,JV)
-     +        +5.*( ALF2(I)*(FZ(I,L,JV)-SZ(I,K,L,JV))+ALF3(I)*TEMPTM )
-           SZ (I,K,L,JV)=ALF (I)*FZ (I,L,JV)+ALF1 (I)*SZ (I,K,L,JV)
-     +                  +3.*TEMPTM
-           SSXZ(I,K,L,JV)=ALF (I)*FXZ(I,L,JV)+ALF1 (I)*SSXZ(I,K,L,JV)
-     +              +3.*(ALF1(I)*FX (I,L,JV)-ALF  (I)*SSX (I,K,L,JV))
-           SYZ(I,K,L,JV)=ALF (I)*FYZ(I,L,JV)+ALF1 (I)*SYZ(I,K,L,JV)
-     +              +3.*(ALF1(I)*FY (I,L,JV)-ALF  (I)*SY (I,K,L,JV))
-           SSX (I,K,L,JV)=SSX (I,K,L,JV)+FX (I,L,JV)
-           SY (I,K,L,JV)=SY (I,K,L,JV)+FY (I,L,JV)
-           SSXX(I,K,L,JV)=SSXX(I,K,L,JV)+FXX(I,L,JV)
-           SSXY(I,K,L,JV)=SSXY(I,K,L,JV)+FXY(I,L,JV)
-           SYY(I,K,L,JV)=SYY(I,K,L,JV)+FYY(I,L,JV)
-C
-         ELSE
-C
-           TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
-           S0 (I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
-           SZZ(I,K,LP,JV)=ALFQ(I)*FZZ(I,L,JV)+ALF1Q(I)*SZZ(I,K,LP,JV)
-     +        +5.*( ALF2(I)*(SZ(I,K,LP,JV)-FZ(I,L,JV))-ALF3(I)*TEMPTM )
-           SZ (I,K,LP,JV)=ALF (I)*FZ(I,L,JV)+ALF1(I)*SZ(I,K,LP,JV)
-     +                   +3.*TEMPTM
-           SSXZ(I,K,LP,JV)=ALF(I)*FXZ(I,L,JV)+ALF1(I)*SSXZ(I,K,LP,JV)
-     +                   +3.*(ALF(I)*SSX(I,K,LP,JV)-ALF1(I)*FX(I,L,JV))
-           SYZ(I,K,LP,JV)=ALF(I)*FYZ(I,L,JV)+ALF1(I)*SYZ(I,K,LP,JV)
-     +                   +3.*(ALF(I)*SY(I,K,LP,JV)-ALF1(I)*FY(I,L,JV))
-           SSX (I,K,LP,JV)=SSX (I,K,LP,JV)+FX (I,L,JV)
-           SY (I,K,LP,JV)=SY (I,K,LP,JV)+FY (I,L,JV)
-           SSXX(I,K,LP,JV)=SSXX(I,K,LP,JV)+FXX(I,L,JV)
-           SSXY(I,K,LP,JV)=SSXY(I,K,LP,JV)+FXY(I,L,JV)
-           SYY(I,K,LP,JV)=SYY(I,K,LP,JV)+FYY(I,L,JV)
-C
-         ENDIF
-C
- 1210 CONTINUE
- 121  CONTINUE
-C
- 12   CONTINUE
-C
-C  fin de la boucle principale sur les latitudes
-C
- 1    CONTINUE
-C
-      DO l = 1,llm
-      DO j = 1,jjp1
-          SM(iip1,j,l) = SM(1,j,l)
-	  S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
-          SSX(iip1,j,l,ntra) = SSX(1,j,l,ntra)
-	  SY(iip1,j,l,ntra) = SY(1,j,l,ntra)
-          SZ(iip1,j,l,ntra) = SZ(1,j,l,ntra)
-      ENDDO
-      ENDDO
-c										C-------------------------------------------------------------
-C *** Test : diag de la qqtite totale de tarceur
-C            dans l'atmosphere avant l'advection en z
-       DO l = 1,llm
-       DO j = 1,jjp1
-       DO i = 1,iim
-          sqf = sqf + S0(i,j,l,ntra)
-       ENDDO
-       ENDDO
-       ENDDO
-       PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
-       PRINT*,'sqf=', sqf
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/bernoui.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/bernoui.F	(revision 1910)
+++ 	(revision )
@@ -1,58 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE bernoui (ngrid,nlay,pphi,pecin,pbern)
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:   P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c     calcul de la fonction de Bernouilli aux niveaux s  .....
-c     phi  et  ecin  sont des arguments d'entree pour le s-pg .......
-c          bern       est un  argument de sortie pour le s-pg  ......
-c
-c    fonction de Bernouilli = bern = filtre de( geopotentiel + 
-c                              energ.cinet.)
-c
-c=======================================================================
-c
-c-----------------------------------------------------------------------
-c   Decalrations:
-c   -------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-c
-c   Arguments:
-c   ----------
-c
-      INTEGER nlay,ngrid
-      REAL pphi(ngrid*nlay),pecin(ngrid*nlay),pbern(ngrid*nlay)
-c
-c   Local:
-c   ------
-c
-      INTEGER   ijl
-c
-c-----------------------------------------------------------------------
-c   calcul de Bernouilli:
-c   ---------------------
-c
-      DO 4 ijl = 1,ngrid*nlay
-         pbern( ijl ) =  pphi( ijl ) + pecin( ijl )
-   4  CONTINUE
-c
-c-----------------------------------------------------------------------
-c   filtre:
-c   -------
-c
-      CALL filtreg( pbern, jjp1, llm, 2,1, .true., 1 )
-c
-c-----------------------------------------------------------------------
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/caldyn0.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/caldyn0.F	(revision 1910)
+++ 	(revision )
@@ -1,89 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE caldyn0
-     $ (itau,ucov,vcov,teta,ps,masse,pk,phis ,
-     $  phi,w,pbaru,pbarv,time )
-
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c  Auteur :  P. Le Van
-c
-c   Objet:
-c   ------
-c
-c   Calcul des tendances dynamiques.
-c
-c Modif 04/93 F.Forget
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   0. Declarations:
-c   ----------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-
-c   Arguments:
-c   ----------
-
-      INTEGER itau
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL ps(ip1jmp1),phis(ip1jmp1)
-      REAL pk(iip1,jjp1,llm)
-      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
-      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-      REAL time
-
-c   Local:
-c   ------
-
-      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
-      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
-      REAL vorpot(ip1jm,llm)
-      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
-      REAL bern(ip1jmp1,llm)
-      REAL massebxy(ip1jm,llm), dp(ip1jmp1)
-    
-
-      INTEGER   ij,l
-
-c-----------------------------------------------------------------------
-c   Calcul des tendances dynamiques:
-c   --------------------------------
-
-      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
-      CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )
-      CALL psextbar (   ps   , psexbarxy                            )
-      CALL massdair (    p   , masse                                )
-      CALL massbar  (   masse, massebx , masseby                    )
-      CALL massbarxy(   masse, massebxy                             )
-      CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
-      CALL convmas  (   pbaru, pbarv   , convm                      )
-
-      DO ij =1, ip1jmp1
-         dp( ij ) = convm( ij,1 ) / airesurg( ij )
-      ENDDO
-
-      CALL vitvert ( convm  , w                                  )
-      CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )
-      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
-      CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )
-
-      DO l=1,llm
-         DO ij=1,ip1jmp1
-            ang(ij,l) = ucov(ij,l) + constang(ij)
-         ENDDO
-      ENDDO
-
-        CALL sortvarc0
-     $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/caldyn_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/caldyn_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/caldyn_loc.F	(revision 1999)
@@ -1,7 +1,5 @@
 !
-! $Header$
+! $Id: $
 !
-c
-c
 #undef DEBUG_IO
 !#define DEBUG_IO
@@ -12,23 +10,24 @@
       USE parallel_lmdz
       USE Write_Field_loc
-      USE caldyn_mod
+      USE caldyn_mod, ONLY: vcont, ucont, ang, p, massebx, masseby,
+     &                      vorpot, ecin, bern, massebxy, convm
       
       IMPLICIT NONE
 
-c=======================================================================
-c
-c  Auteur :  P. Le Van
-c
-c   Objet:
-c   ------
-c
-c   Calcul des tendances dynamiques.
-c
-c Modif 04/93 F.Forget
-c=======================================================================
+!=======================================================================
+!
+!  Auteur :  P. Le Van
+!
+!   Objet:
+!   ------
+!
+!   Calcul des tendances dynamiques.
+!
+! Modif 04/93 F.Forget
+!=======================================================================
 
-c-----------------------------------------------------------------------
-c   0. Declarations:
-c   ----------------
+!-----------------------------------------------------------------------
+!   0. Declarations:
+!   ----------------
 
 #include "dimensions.h"
@@ -38,39 +37,54 @@
 #include "comgeom.h"
 
-c   Arguments:
-c   ----------
+!   Arguments:
+!   ----------
 
-      LOGICAL conser
+      LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics ! not used
+      INTEGER,INTENT(IN) :: itau ! time step index ! not used
+      REAL,INTENT(IN) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
+      REAL,INTENT(IN) :: ucov(ijb_u:ije_u,llm) ! covariant zonal wind
+      REAL,INTENT(IN) :: teta(ijb_u:ije_u,llm) ! potential temperature
+      REAL,INTENT(IN) :: ps(ijb_u:ije_u) ! surface pressure
+      REAL,INTENT(IN) :: phis(ijb_u:ije_u) ! geopotential at the surface
+      REAL,INTENT(IN) :: pk(iip1,jjb_u:jje_u,llm) ! Exner at mid-layer
+      REAL,INTENT(IN) :: pkf(ijb_u:ije_u,llm) ! filtered Exner
+      REAL,INTENT(IN) :: phi(ijb_u:ije_u,llm) ! geopotential
+      REAL,INTENT(OUT) :: masse(ijb_u:ije_u,llm) ! air mass
+      REAL,INTENT(OUT) :: dv(ijb_v:ije_v,llm) ! tendency on vcov
+      REAL,INTENT(OUT) :: du(ijb_u:ije_u,llm) ! tendency on ucov
+      REAL,INTENT(OUT) :: dteta(ijb_u:ije_u,llm) ! tenddency on teta
+      REAL,INTENT(OUT) :: dp(ijb_u:ije_u) ! tendency on ps
+      REAL,INTENT(OUT) :: w(ijb_u:ije_u,llm) ! vertical velocity
+      REAL,INTENT(OUT) :: pbaru(ijb_u:ije_u,llm) ! mass flux in the zonal direction
+      REAL,INTENT(OUT) :: pbarv(ijb_v:ije_v,llm) ! mass flux in the meridional direction
+      REAL,INTENT(IN) :: time ! current time
 
-      INTEGER itau
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-      REAL teta(ijb_u:ije_u,llm)
-      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
-      REAL pk(iip1,jjb_u:jje_u,llm),pkf(ijb_u:ije_u,llm)
-      REAL phi(ijb_u:ije_u,llm),masse(ijb_u:ije_u,llm)
-      REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm)
-      REAL dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)
-      REAL w(ijb_u:ije_u,llm)
-      REAL pbaru(ijb_u:ije_u,llm),pbarv(ijb_v:ije_v,llm)
-      REAL time
-
-c   Local:
-c   ------
+!   Local:
+!   ------
 
       INTEGER   ij,l,ijb,ije,ierr
 
 
-c-----------------------------------------------------------------------
-c   Calcul des tendances dynamiques:
-c   --------------------------------
+!-----------------------------------------------------------------------
+!   Compute dynamical tendencies:
+!--------------------------------
+
+      ! compute contravariant winds ucont() and vcont
       CALL covcont_loc  ( llm    , ucov    , vcov , ucont, vcont     )
+      ! compute pressure p()
       CALL pression_loc ( ip1jmp1, ap      , bp   ,  ps  , p         )
 cym      CALL psextbar (   ps   , psexbarxy                          )
 c$OMP BARRIER
+      ! compute mass in each atmospheric mesh: masse()
       CALL massdair_loc (    p   , masse                             )
+      ! compute X and Y-averages of mass, massebx() and masseby()
       CALL massbar_loc  (   masse, massebx , masseby                 )
+      ! compute XY-average of mass, massebxy()
       call massbarxy_loc(   masse, massebxy                          )
+      ! compute mass fluxes pbaru() and pbarv()
       CALL flumass_loc  ( massebx, masseby,vcont,ucont,pbaru,pbarv   )
+      ! compute dteta() , horizontal converging flux of theta
       CALL dteta1_loc   (   teta , pbaru   , pbarv, dteta            )
+      ! compute convm(), horizontal converging flux of mass
       CALL convmas1_loc  (   pbaru, pbarv   , convm                  )
 c$OMP BARRIER      
@@ -95,5 +109,5 @@
       ijb=ij_begin
       ije=ij_end
-            
+      ! compute pressure variation due to mass convergence
       DO ij =ijb, ije
          dp( ij ) = convm( ij,1 ) / airesurg( ij )
@@ -101,6 +115,10 @@
 c$OMP END MASTER
 c$OMP BARRIER
+      
+      ! compute vertical velocity w()
       CALL vitvert_loc ( convm  , w                                )
+      ! compute potential vorticity vorpot()
       CALL tourpot_loc ( vcov   , ucov  , massebxy  , vorpot       )
+      ! compute rotation induced du() and dv()
       CALL dudv1_loc   ( vorpot , pbaru , pbarv     , du     , dv  )
 
@@ -111,6 +129,10 @@
       call WriteField_v('dv',dv)
 #endif      
+      
+      ! compute kinetic energy ecin()
       CALL enercin_loc ( vcov   , ucov  , vcont   , ucont  , ecin  )
+      ! compute Bernouilli function bern()
       CALL bernoui_loc ( ip1jmp1, llm   , phi       , ecin   , bern)
+      ! compute and add du() and dv() contributions from Bernouilli and pressure
       CALL dudv2_loc   ( teta   , pkf   , bern      , du     , dv  )
 
@@ -137,4 +159,5 @@
 c$OMP END DO
 
+      ! compute vertical advection contributions to du(), dv() and dteta()
       CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta) 
 
@@ -158,4 +181,5 @@
 c$OMP END DO NOWAIT      
 
+! Ehouarn: NB: output of control variables not implemented...
 
       RETURN
Index: LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/calfis_loc.F	(revision 1999)
@@ -41,6 +41,6 @@
       Use Write_field_p
       USE Times
-      USE infotrac
-      USE control_mod
+      USE infotrac, ONLY: nqtot, niadv, tname
+      USE control_mod, ONLY: planet_type, nsplit_phys
 
       IMPLICIT NONE
@@ -115,34 +115,33 @@
 c    Arguments :
 c    -----------
-      LOGICAL  lafin
-!      REAL heure
-      REAL, intent(in):: jD_cur, jH_cur
-      REAL pvcov(iip1,jjb_v:jje_v,llm)
-      REAL pucov(iip1,jjb_u:jje_u,llm)
-      REAL pteta(iip1,jjb_u:jje_u,llm)
-      REAL pmasse(iip1,jjb_u:jje_u,llm)
-      REAL pq(iip1,jjb_u:jje_u,llm,nqtot)
-      REAL pphis(iip1,jjb_u:jje_u)
-      REAL pphi(iip1,jjb_u:jje_u,llm)
-c
-      REAL pdvcov(iip1,jjb_v:jje_v,llm)
-      REAL pducov(iip1,jjb_u:jje_u,llm)
-      REAL pdteta(iip1,jjb_u:jje_u,llm)
-      REAL pdq(iip1,jjb_u:jje_u,llm,nqtot)
-      REAL flxw(iip1,jjb_u:jje_u,llm)  ! Flux de masse verticale sur la grille dynamique
-c
-      REAL pps(iip1,jjb_u:jje_u)
-      REAL pp(iip1,jjb_u:jje_u,llmp1)
-      REAL ppk(iip1,jjb_u:jje_u,llm)
-c
-      REAL pdvfi(iip1,jjb_v:jje_v,llm)
-      REAL pdufi(iip1,jjb_u:jje_u,llm)
-      REAL pdhfi(iip1,jjb_u:jje_u,llm)
-      REAL pdqfi(iip1,jjb_u:jje_u,llm,nqtot)
-      REAL pdpsfi(iip1,jjb_u:jje_u)
-
-      INTEGER        longcles
-      PARAMETER    ( longcles = 20 )
-      REAL clesphy0( longcles )
+      LOGICAL,INTENT(IN) ::  lafin ! .true. for the very last call to physics
+      REAL,INTENT(IN):: jD_cur, jH_cur
+      REAL,INTENT(IN):: pvcov(iip1,jjb_v:jje_v,llm) ! covariant meridional velocity
+      REAL,INTENT(IN):: pucov(iip1,jjb_u:jje_u,llm) ! covariant zonal velocity
+      REAL,INTENT(IN):: pteta(iip1,jjb_u:jje_u,llm) ! potential temperature
+      REAL,INTENT(IN):: pmasse(iip1,jjb_u:jje_u,llm) ! mass in each cell ! not used
+      REAL,INTENT(IN):: pq(iip1,jjb_u:jje_u,llm,nqtot) ! tracers
+      REAL,INTENT(IN):: pphis(iip1,jjb_u:jje_u) ! surface geopotential
+      REAL,INTENT(IN):: pphi(iip1,jjb_u:jje_u,llm) ! geopotential
+
+      REAL,INTENT(IN) :: pdvcov(iip1,jjb_v:jje_v,llm) ! dynamical tendency on vcov ! not used
+      REAL,INTENT(IN) :: pducov(iip1,jjb_u:jje_u,llm) ! dynamical tendency on ucov
+      REAL,INTENT(IN) :: pdteta(iip1,jjb_u:jje_u,llm) ! dynamical tendency on teta ! not used
+      REAL,INTENT(IN) :: pdq(iip1,jjb_u:jje_u,llm,nqtot) ! dynamical tendency on tracers ! not used
+
+      REAL,INTENT(IN) :: pps(iip1,jjb_u:jje_u) ! surface pressure (Pa)
+      REAL,INTENT(IN) :: pp(iip1,jjb_u:jje_u,llmp1) ! pressure at mesh interfaces (Pa)
+      REAL,INTENT(IN) :: ppk(iip1,jjb_u:jje_u,llm) ! Exner at mid-layer
+      REAL,INTENT(IN) :: flxw(iip1,jjb_u:jje_u,llm)  ! Vertical mass flux on dynamics grid
+
+      ! tendencies (in */s) from the physics
+      REAL,INTENT(OUT) :: pdvfi(iip1,jjb_v:jje_v,llm) ! tendency on covariant meridional wind
+      REAL,INTENT(OUT) :: pdufi(iip1,jjb_u:jje_u,llm) ! tendency on covariant zonal wind
+      REAL,INTENT(OUT) :: pdhfi(iip1,jjb_u:jje_u,llm) ! tendency on potential temperature (K/s)
+      REAL,INTENT(OUT) :: pdqfi(iip1,jjb_u:jje_u,llm,nqtot) ! tendency on tracers
+      REAL,INTENT(OUT) :: pdpsfi(iip1,jjb_u:jje_u) ! tendency on surface pressure (Pa/s)
+
+      INTEGER,PARAMETER :: longcles = 20
+      REAL,INTENT(IN) :: clesphy0( longcles ) ! unused
 
 
@@ -221,8 +220,6 @@
 c
 cIM diagnostique PVteta, Amip2
-      INTEGER ntetaSTD
-      PARAMETER(ntetaSTD=3)
-      REAL rtetaSTD(ntetaSTD)
-      DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
+      INTEGER,PARAMETER :: ntetaSTD=3
+      REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
       REAL PVteta(klon,ntetaSTD)
       
@@ -230,7 +227,5 @@
       REAL SSUM
 
-      LOGICAL firstcal, debut
-      DATA firstcal/.true./
-      SAVE firstcal,debut
+      LOGICAL,SAVE :: firstcal=.true., debut=.true.
 c$OMP THREADPRIVATE(firstcal,debut)
       
Index: LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/call_calfis_mod.F90	(revision 1999)
@@ -91,15 +91,15 @@
     INCLUDE "iniprint.h"
 
-    REAL    :: clesphy0( : )    
-    INTEGER :: itau
-    LOGICAL :: lafin 
-    REAL :: ucov_dyn(ijb_u:ije_u,llm)
-    REAL :: vcov_dyn(ijb_v:ije_v,llm) 
-    REAL :: teta_dyn(ijb_u:ije_u,llm) 
-    REAL :: masse_dyn(ijb_u:ije_u,llm) 
-    REAL :: ps_dyn(ijb_u:ije_u) 
-    REAL :: phis_dyn(ijb_u:ije_u) 
-    REAL :: q_dyn(ijb_u:ije_u,llm,nqtot) 
-    REAL :: flxw_dyn(ijb_u:ije_u,llm) 
+    INTEGER,INTENT(IN) :: itau ! (time) iteration step number
+    LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
+    REAL,INTENT(IN) :: clesphy0( : ) ! not used    
+    REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
+    REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
+    REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! potential temperature
+    REAL,INTENT(INOUT) :: masse_dyn(ijb_u:ije_u,llm) ! air mass
+    REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
+    REAL,INTENT(INOUT) :: phis_dyn(ijb_u:ije_u) ! surface geopotential
+    REAL,INTENT(INOUT) :: q_dyn(ijb_u:ije_u,llm,nqtot) ! advected tracers
+    REAL,INTENT(INOUT) :: flxw_dyn(ijb_u:ije_u,llm) ! vertical mass flux
 
     REAL :: dufi_tmp(iip1,llm)    
@@ -134,5 +134,7 @@
   !$OMP MASTER
     CALL suspend_timer(timer_caldyn)
-    WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
+    IF (prt_level >= 10) THEN
+      WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
+    ENDIF
   !$OMP END MASTER
    
@@ -335,4 +337,15 @@
                     ucov, vcov, teta , q   ,ps ,            &
                     dufi, dvfi, dtetafi , dqfi ,dpfi  )
+    ! since addfi updates ps(), also update p(), masse() and pk()
+    CALL pression_loc(ip1jmp1,ap,bp,ps,p)
+!$OMP BARRIER
+    CALL massdair_loc(p,masse)
+!$OMP BARRIER
+    if (pressure_exner) then
+      CALL exner_hyb_loc(ijnb_u,ps,p,alpha,beta,pks,pk,pkf)
+    else 
+      CALL exner_milieu_loc(ijnb_u,ps,p,beta,pks,pk,pkf)
+    endif
+!$OMP BARRIER
 
 #ifdef DEBUG_IO    
Index: LMDZ5/branches/testing/libf/dyn3dmem/call_dissip_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/call_dissip_mod.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/call_dissip_mod.F90	(revision 1999)
@@ -87,10 +87,10 @@
   IMPLICIT NONE
     INCLUDE 'comgeom.h'
-    REAL :: ucov_dyn(ijb_u:ije_u,llm)
-    REAL :: vcov_dyn(ijb_v:ije_v,llm)
-    REAL :: teta_dyn(ijb_u:ije_u,llm)
-    REAL :: p_dyn(ijb_u:ije_u,llmp1 )
-    REAL :: pk_dyn(ijb_u:ije_u,llm)
-    REAL :: ps_dyn(ijb_u:ije_u)
+    REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
+    REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
+    REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! covariant meridional wind
+    REAL,INTENT(INOUT) :: p_dyn(ijb_u:ije_u,llmp1 ) ! pressure at interlayer
+    REAL,INTENT(INOUT) :: pk_dyn(ijb_u:ije_u,llm) ! Exner at midlayer
+    REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
     REAL :: tppn(iim),tpps(iim)
     REAL :: tpn,tps
Index: LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/ce0l.F90	(revision 1999)
@@ -115,12 +115,10 @@
   END IF
 
-  IF (grilles_gcm_netcdf) THEN
-     WRITE(lunout,'(//)')
-     WRITE(lunout,*) '  ***************************  '
-     WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
-     WRITE(lunout,*) '  ***************************  '
-     WRITE(lunout,'(//)')
-     CALL grilles_gcm_netcdf_sub(masque,phis)
-  END IF
+  WRITE(lunout,'(//)')
+  WRITE(lunout,*) '  ***************************  '
+  WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
+  WRITE(lunout,*) '  ***************************  '
+  WRITE(lunout,'(//)')
+  CALL grilles_gcm_netcdf_sub(masque,phis)
   
 #ifdef CPP_MPI
Index: LMDZ5/branches/testing/libf/dyn3dmem/clesph0.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/clesph0.h	(revision 1910)
+++ 	(revision )
@@ -1,11 +1,0 @@
-!
-! $Header$
-!
-c..include clesph0.h
-c
-       COMMON/clesph0/cycle_diurne, soil_model,new_oliq, ok_orodr ,
-     ,                ok_orolf ,ok_limitvrai, nbapp_rad, iflag_con
-c
-       LOGICAL cycle_diurne,soil_model,ok_orodr,ok_orolf,new_oliq
-       LOGICAL ok_limitvrai
-       INTEGER nbapp_rad, iflag_con
Index: LMDZ5/branches/testing/libf/dyn3dmem/coefpoly.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/coefpoly.F	(revision 1910)
+++ 	(revision )
@@ -1,40 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
-     ,                                          a0,a1,a2,a3         )
-      IMPLICIT NONE
-c
-c   ...  Auteur :   P. Le Van  ...
-c
-c
-c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
-c      satisfait aux 4 equations  suivantes :
-
-c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
-c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
-c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
-c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
-
-c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
-
-      REAL(KIND=8) Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi 
-      REAL(KIND=8) Xfout, Xprim
-      REAL(KIND=8) a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
-
-      xtil1car = xtild1 * xtild1
-      xtil2car = xtild2 * xtild2 
-
-      derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
-
-      x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
-
-      a3 = (derr + Xprim1+Xprim2 )/x1x2car
-      a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
-     /           (  2.* ( xtild1 - xtild2 )  )
-
-      a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
-      a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/com_io_dyn_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/com_io_dyn_mod.F90	(revision 1910)
+++ 	(revision )
@@ -1,31 +1,0 @@
-!
-! $Id $
-!
-module com_io_dyn_mod
-
-  implicit none 
-
-! Names of various files for outputs (in the dynamics)
-  ! to store instantaneous values:
-  character(len=18),parameter :: dynhist_file="dyn_hist.nc" ! on scalar grid
-  character(len=18),parameter :: dynhistv_file="dyn_histv.nc" ! on v grid
-  character(len=18),parameter :: dynhistu_file="dyn_histu.nc" ! on u grid
-
-  ! to store averaged values:
-  character(len=18),parameter :: dynhistave_file="dyn_hist_ave.nc"
-  character(len=18),parameter :: dynhistvave_file="dyn_histv_ave.nc"
-  character(len=18),parameter :: dynhistuave_file="dyn_histu_ave.nc"
-  
-! Ids of various files for outputs (in the dynamics)
-
-  ! instantaneous (these are set by inithist.F)
-  integer :: histid
-  integer :: histvid
-  integer :: histuid
-  
-  ! averages (these are set by initdynav.F)
-  integer :: histaveid
-  integer :: histvaveid
-  integer :: histuaveid
-  
-end module com_io_dyn_mod
Index: LMDZ5/branches/testing/libf/dyn3dmem/comconst.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comconst.h	(revision 1910)
+++ 	(revision )
@@ -1,42 +1,0 @@
-!
-! $Id: comconst.h 1671 2012-10-24 07:10:10Z emillour $
-!
-!-----------------------------------------------------------------------
-! INCLUDE comconst.h
-
-      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
-     &                 iflag_top_bound,mode_top_bound
-      COMMON/comconstr/dtvr,daysec,                                     &
-     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
-     &                   ,dissip_factz,dissip_deltaz,dissip_zref        &
-     &                   ,tau_top_bound,                                &
-     & daylen,year_day,molmass, ihf
-
-
-      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
-      REAL dtvr ! dynamical time step (in s)
-      REAL daysec !length (in s) of a standard day
-      REAL pi    ! something like 3.14159....
-      REAL dtphys ! (s) time step for the physics
-      REAL dtdiss ! (s) time step for the dissipation
-      REAL rad ! (m) radius of the planet
-      REAL r ! Reduced Gas constant r=R/mu
-             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
-      REAL cpp   ! Specific heat Cp (J.kg-1.K-1)
-      REAL kappa ! kappa=R/Cp 
-      REAL cotot
-      REAL unsim ! = 1./iim
-      REAL g ! (m/s2) gravity
-      REAL omeg ! (rad/s) rotation rate of the planet
-      REAL dissip_factz,dissip_deltaz,dissip_zref
-! top_bound sponge:
-      INTEGER iflag_top_bound ! sponge type
-      INTEGER mode_top_bound  ! sponge mode
-      REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
-      REAL daylen ! length of solar day, in 'standard' day length
-      REAL year_day ! Number of standard days in a year
-      REAL molmass ! (g/mol) molar mass of the atmosphere
-
-      REAL ihf ! (W/m2) Intrinsic heat flux (for giant planets)
-
-!-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/comdissip.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comdissip.h	(revision 1910)
+++ 	(revision )
@@ -1,15 +1,0 @@
-!
-! $Header$
-!
-!-----------------------------------------------------------------------
-! INCLUDE comdissip.h
-
-      COMMON/comdissip/                                                 &
-     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
-
-
-      INTEGER niterdis
-
-      REAL tetavel,tetatemp,coefdis,gamdissip
-
-!-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/comdissipn.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comdissipn.h	(revision 1910)
+++ 	(revision )
@@ -1,20 +1,0 @@
-!
-! $Id$
-!
-!  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 comdissipn.h
-
-      REAL  tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
-!
-      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,     &
-     &                        cdivu,      crot,         cdivh
-
-!
-!    Les parametres de ce common proviennent des calculs effectues dans 
-!             Inidissip  .
-!
-!-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/comdissnew.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comdissnew.h	(revision 1910)
+++ 	(revision )
@@ -1,30 +1,0 @@
-!
-! $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'
-
-      COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,  &
-     &                   tetagrot,tetatemp,coefdis, vert_prof_dissip
-
-      LOGICAL lstardis
-      INTEGER nitergdiv, nitergrot, niterh
-
-      integer vert_prof_dissip ! vertical profile of horizontal dissipation
-!     Allowed values:
-!     0: rational fraction, function of pressure
-!     1: tanh of altitude
-
-      REAL     tetagdiv, tetagrot,  tetatemp, coefdis
-
-!
-! ... Les parametres de ce common comdissnew sont  lues par defrun_new 
-!              sur le fichier  run.def    ....
-!
-!-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/comgeom.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comgeom.h	(revision 1910)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-!CDK comgeom
-      COMMON/comgeom/                                                   &
-     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
-     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
-     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
-     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
-     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
-     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
-     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
-     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
-     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
-     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
-     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
-     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
-     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
-     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
-     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
-     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
-
-!
-        REAL                                                            &
-     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
-     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
-     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
-     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
-     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
-     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
-     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
-     & , xprimv
-!
Index: LMDZ5/branches/testing/libf/dyn3dmem/comgeom2.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comgeom2.h	(revision 1910)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-!CDK comgeom2
-      COMMON/comgeom/                                                   &
-     & cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  , &
-     & aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           , &
-     & airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 , &
-     & unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       , &
-     & aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       , &
-     & aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         , &
-     & alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        , &
-     & alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    , &
-     & fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),      &
-     & rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  , &
-     & cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        , &
-     & cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1), &
-     & cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) , &
-     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                , &
-     & unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  , &
-     & unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)  &
-     & , xprimu(iip1),xprimv(iip1)
-
-
-      REAL                                                               &
-     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire &
-     & ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     , &
-     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 , &
-     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     , &
-     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           , &
-     & unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     , &
-     & unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    , &
-     & cusurcvu,xprimu,xprimv
Index: LMDZ5/branches/testing/libf/dyn3dmem/comvert.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/comvert.h	(revision 1910)
+++ 	(revision )
@@ -1,38 +1,0 @@
-!
-! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
-!
-!-----------------------------------------------------------------------
-!   INCLUDE 'comvert.h'
-
-      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
-     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
-     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
-
-      common/comverti/disvert_type, pressure_exner
-
-      real ap     ! hybrid pressure contribution at interlayers
-      real bp     ! hybrid sigma contribution at interlayer
-      real presnivs ! (reference) pressure at mid-layers
-      real dpres
-      real pa     ! reference pressure (Pa) at which hybrid coordinates
-                  ! become purely pressure
-      real preff  ! reference surface pressure (Pa)
-      real nivsigs
-      real nivsig
-      real aps    ! hybrid pressure contribution at mid-layers
-      real bps    ! hybrid sigma contribution at mid-layers
-      real scaleheight ! atmospheric (reference) scale height (km)
-      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
-                     ! preff and scaleheight
-
-      integer disvert_type ! type of vertical discretization:
-                           ! 1: Earth (default for planet_type==earth),
-                           !     automatic generation
-                           ! 2: Planets (default for planet_type!=earth),
-                           !     using 'z2sig.def' (or 'esasig.def) file
-
-      logical pressure_exner
-!     compute pressure inside layers using Exner function, else use mean
-!     of pressure values at interfaces
-
- !-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/conf_dat2d.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/conf_dat2d.F	(revision 1910)
+++ 	(revision )
@@ -1,221 +1,0 @@
-!
-! $Header$
-!
-C
-C
-      SUBROUTINE conf_dat2d( title,lons,lats,xd,yd,xf,yf,champd ,
-     ,                           interbar                        )
-c
-c     Auteur :  P. Le Van
-
-c    Ce s-pr. configure le champ de donnees 2D 'champd' de telle facon que
-c       qu'on ait     - pi    a    pi    en longitude
-c       et qu'on ait   pi/2.  a - pi/2.  en latitude
-c
-c      xd et yd  sont les longitudes et latitudes initiales
-c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
-c      modifiees pour etre configurees comme ci-dessus .
-
-      IMPLICIT NONE
- 
-c    ***       Arguments en  entree      ***
-      INTEGER lons,lats
-      CHARACTER*25 title
-      REAL xd(lons),yd(lats)
-      LOGICAL interbar
-c
-c    ***       Arguments en  sortie      ***
-      REAL xf(lons),yf(lats)
-c
-c    ***  Arguments en entree et  sortie ***
-      REAL champd(lons,lats)
-
-c   ***     Variables  locales  ***
-c
-      REAL pi,pis2,depi
-      LOGICAL radianlon, invlon ,radianlat, invlat, alloc
-      REAL rlatmin,rlatmax,oldxd1
-      INTEGER i,j,ip180,ind
-
-      REAL, ALLOCATABLE :: xtemp(:) 
-      REAL, ALLOCATABLE :: ytemp(:) 
-      REAL, ALLOCATABLE :: champf(:,:)
-     
-c
-c      WRITE(6,*) ' conf_dat2d  pour la variable ', title
-
-      ALLOCATE( xtemp(lons) )
-      ALLOCATE( ytemp(lats) )
-      ALLOCATE( champf(lons,lats) )
-
-      DO i = 1, lons
-       xtemp(i) = xd(i)
-      ENDDO
-      DO j = 1, lats
-       ytemp(j) = yd(j)
-      ENDDO
-
-      pi   = 2. * ASIN(1.) 
-      pis2 = pi/2.
-      depi = 2. * pi
-
-            radianlon = .FALSE.
-      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
-            radianlon = .TRUE.
-            invlon    = .FALSE.
-      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
-            radianlon = .TRUE.
-            invlon    = .TRUE.
-      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
-            radianlon = .FALSE.
-            invlon    = .FALSE.
-      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
-            radianlon = .FALSE.
-            invlon    = .TRUE.
-      ELSE
-        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
-     ,  , title
-      ENDIF
-
-      invlat = .FALSE.
-      
-      IF( ytemp(1).LT.ytemp(lats) ) THEN
-        invlat = .TRUE.
-      ENDIF
-
-      rlatmin = MIN( ytemp(1), ytemp(lats) )
-      rlatmax = MAX( ytemp(1), ytemp(lats) )
-      
-      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
-             radianlat = .TRUE.
-      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
-             radianlat = .FALSE.
-      ELSE
-        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
-     ,  , title
-      ENDIF
-
-       IF( .NOT. radianlon )  THEN
-         DO i = 1, lons
-          xtemp(i) = xtemp(i) * pi/180.
-         ENDDO
-       ENDIF
-
-       IF( .NOT. radianlat )  THEN
-         DO j = 1, lats
-          ytemp(j) = ytemp(j) * pi/180.
-         ENDDO   
-       ENDIF
-
-
-        IF ( invlon )   THEN
-
-           DO j = 1, lats
-            DO i = 1,lons
-             champf(i,j) = champd(i,j)
-            ENDDO
-           ENDDO
-
-           DO i = 1 ,lons
-            xf(i) = xtemp(i)
-           ENDDO
-c
-c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
-c
-           DO i=1,lons
-            IF( xf(i).GT. pi )  THEN
-            GO TO 88
-            ENDIF
-           ENDDO
-
-88         CONTINUE
-c
-           ip180 = i
-
-           DO i = 1,lons
-            IF (xf(i).GT. pi)  THEN
-             xf(i) = xf(i) - depi
-            ENDIF
-           ENDDO
-
-           DO i= ip180,lons
-            ind = i-ip180 +1
-            xtemp(ind) = xf(i)
-           ENDDO
-
-           DO i= ind +1,lons
-            xtemp(i) = xf(i-ind)
-           ENDDO
-
-c   .....    on tourne les longitudes  pour  champf ....
-c
-           DO j = 1,lats
-
-             DO i = ip180,lons
-              ind  = i-ip180 +1
-              champd (ind,j) = champf (i,j)
-             ENDDO
-   
-             DO i= ind +1,lons
-              champd (i,j)  = champf (i-ind,j)
-             ENDDO
-
-           ENDDO
-
-
-        ENDIF
-c
-c    *****   fin  de   IF(invlon)   ****
-
-         IF ( invlat )    THEN
-
-           DO j = 1,lats
-            yf(j) = ytemp(j)
-           ENDDO
-
-           DO j = 1, lats
-             DO i = 1,lons
-              champf(i,j) = champd(i,j)
-             ENDDO
-           ENDDO
-
-           DO j = 1, lats
-              ytemp( lats-j+1 ) = yf(j)
-              DO i = 1, lons
-               champd (i,lats-j+1) = champf (i,j)
-              ENDDO
-           ENDDO
-
-
-         ENDIF
-
-c    *****  fin  de  IF(invlat)   ****
-
-c        
-      IF( interbar )  THEN
-        oldxd1 = xtemp(1)
-        DO i = 1, lons -1
-          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
-        ENDDO
-          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
-
-        DO j = 1, lats -1
-          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
-        ENDDO
-
-      ENDIF
-c
-        DEALLOCATE(champf)
-
-       DO i = 1, lons
-        xf(i) = xtemp(i)
-       ENDDO
-       DO j = 1, lats
-        yf(j) = ytemp(j)
-       ENDDO
-
-      deallocate(xtemp)
-      deallocate(ytemp)
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/conf_dat3d.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/conf_dat3d.F	(revision 1910)
+++ 	(revision )
@@ -1,296 +1,0 @@
-!
-! $Header$
-!
-C
-C
-      SUBROUTINE conf_dat3d( title, lons,lats,levs,xd,yd,zd,xf,yf,zf,
-     ,                                 champd , interbar             )
-c
-c     Auteur : P. Le Van
-c
-c    Ce s-pr. configure le champ de donnees 3D 'champd' de telle facon 
-c       qu'on ait     - pi    a    pi    en longitude
-c       qu'on ait      pi/2.  a - pi/2.  en latitude
-c      et qu'on ait les niveaux verticaux variant du sol vers le ht de l'atmos.
-c           (     en Pascals   ) .
-c
-c      xd et yd  sont les longitudes et latitudes initiales
-c      zd  les pressions initiales
-c
-c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
-c       modifiees pour etre configurees comme ci-dessus .
-c      zf  les pressions en sortie
-c
-c      champd   en meme temps le champ initial et  final
-c
-c      interbar = .TRUE.  si on appelle l'interpo. barycentrique inter_barxy
-c          sinon , l'interpolation   grille_m  ( grid_atob ) .
-c
-
-      IMPLICIT NONE
- 
-c    ***       Arguments en  entree      ***
-      CHARACTER*(*) :: title
-      INTEGER lons, lats, levs
-      REAL xd(lons), yd(lats), zd(levs)
-      LOGICAL interbar
-c
-c    ***       Arguments en  sortie      ***
-      REAL xf(lons), yf(lats), zf(levs)
-
-c    ***  Arguments en entree et  sortie ***
-      REAL  champd(lons,lats,levs)
-
-c    ***  Variables locales  ***
-c
-      REAL pi,pis2,depi,presmax
-      LOGICAL radianlon, invlon ,radianlat, invlat, invlev, alloc
-      REAL rlatmin,rlatmax,oldxd1
-      INTEGER i,j,ip180,ind,l
-
-      REAL, ALLOCATABLE :: xtemp(:)
-      REAL, ALLOCATABLE :: ytemp(:)
-      REAL, ALLOCATABLE :: ztemp(:)
-      REAL, ALLOCATABLE :: champf(:,:,:)
-     
-
-c      WRITE(6,*) '  Conf_dat3d  pour  ',title
-
-      ALLOCATE(xtemp(lons))
-      ALLOCATE(ytemp(lats))
-      ALLOCATE(ztemp(levs))
-
-      DO i = 1, lons
-       xtemp(i) = xd(i)
-      ENDDO
-      DO j = 1, lats
-       ytemp(j) = yd(j)
-      ENDDO
-      DO l = 1, levs
-       ztemp(l) = zd(l)
-      ENDDO
-
-      pi   = 2. * ASIN(1.) 
-      pis2 = pi/2.
-      depi = 2. * pi
-
-      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
-            radianlon = .TRUE.
-            invlon    = .FALSE.
-      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
-            radianlon = .TRUE.
-            invlon    = .TRUE.
-      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
-            radianlon = .FALSE.
-            invlon    = .FALSE.
-      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
-            radianlon = .FALSE.
-            invlon    = .TRUE.
-      ELSE
-        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
-     ,  , title
-      ENDIF
-
-      invlat = .FALSE.
-      
-      IF( ytemp(1).LT.ytemp(lats) ) THEN
-        invlat = .TRUE.
-      ENDIF
-
-      rlatmin = MIN( ytemp(1), ytemp(lats) )
-      rlatmax = MAX( ytemp(1), ytemp(lats) )
-      
-      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
-             radianlat = .TRUE.
-      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
-             radianlat = .FALSE.
-      ELSE
-        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
-     ,  , title
-      ENDIF
-
-       IF( .NOT. radianlon )  THEN
-         DO i = 1, lons
-          xtemp(i) = xtemp(i) * pi/180.
-         ENDDO
-       ENDIF
-
-       IF( .NOT. radianlat )  THEN
-         DO j = 1, lats
-          ytemp(j) = ytemp(j) * pi/180.
-         ENDDO   
-       ENDIF
-
-
-        alloc =.FALSE.
-
-        IF ( invlon )   THEN
-
-            ALLOCATE(champf(lons,lats,levs))
-            alloc = .TRUE.
-
-            DO i = 1 ,lons
-             xf(i) = xtemp(i)
-            ENDDO
-
-            DO l = 1, levs
-             DO j = 1, lats
-              DO i= 1, lons
-               champf (i,j,l)  = champd (i,j,l)
-              ENDDO
-             ENDDO
-            ENDDO
-c
-c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
-c
-            DO i=1,lons
-             IF( xf(i).GT. pi )  THEN
-              GO TO 88
-             ENDIF
-            ENDDO
-
-88          CONTINUE
-c
-            ip180 = i
-
-            DO i = 1,lons
-             IF (xf(i).GT. pi)  THEN
-              xf(i) = xf(i) - depi
-             ENDIF
-            ENDDO
-
-            DO i= ip180,lons
-             ind = i-ip180 +1
-             xtemp(ind) = xf(i)
-            ENDDO
-
-            DO i= ind +1,lons
-             xtemp(i) = xf(i-ind)
-            ENDDO
-
-c   .....    on tourne les longitudes  pour champf  ....
-c
-            DO l = 1,levs
-              DO j = 1,lats
-               DO i = ip180,lons
-                ind  = i-ip180 +1
-                champd (ind,j,l) = champf (i,j,l)
-               ENDDO
-   
-               DO i= ind +1,lons
-                champd (i,j,l)  = champf (i-ind,j,l)
-               ENDDO
-              ENDDO
-            ENDDO
-
-        ENDIF
-c
-c    *****   fin  de   IF(invlon)   ****
-         
-         IF ( invlat )    THEN
-
-           IF(.NOT.alloc)  THEN 
-            ALLOCATE(champf(lons,lats,levs))
-            alloc = .TRUE.
-           ENDIF
-
-           DO j = 1, lats
-            yf(j) = ytemp(j)
-           ENDDO
-         
-           DO l = 1,levs
-            DO j = 1, lats
-             DO i = 1,lons
-              champf(i,j,l) = champd(i,j,l)
-             ENDDO
-            ENDDO
-
-            DO j = 1, lats
-              ytemp( lats-j+1 ) = yf(j)
-              DO i = 1, lons
-               champd (i,lats-j+1,l) = champf (i,j,l)
-              ENDDO
-            ENDDO
-          ENDDO
-
-
-         ENDIF
-
-c    *****  fin  de  IF(invlat)   ****
-c
-c
-      IF( interbar )  THEN
-        oldxd1 = xtemp(1)
-        DO i = 1, lons -1
-          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
-        ENDDO
-          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
-
-        DO j = 1, lats -1
-          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
-        ENDDO
-      ENDIF
-c
-
-      invlev = .FALSE.
-      IF( ztemp(1).LT.ztemp(levs) )  invlev = .TRUE.
-
-      presmax = MAX( ztemp(1), ztemp(levs) )
-      IF( presmax.LT.1200. ) THEN
-         DO l = 1,levs
-           ztemp(l) = ztemp(l) * 100.
-         ENDDO
-      ENDIF
-
-      IF( invlev )  THEN
-
-          IF(.NOT.alloc)  THEN
-            ALLOCATE(champf(lons,lats,levs))
-            alloc = .TRUE.
-          ENDIF
-
-          DO l = 1,levs
-            zf(l) = ztemp(l)
-          ENDDO
-
-          DO l = 1,levs
-            DO j = 1, lats
-             DO i = 1,lons
-              champf(i,j,l) = champd(i,j,l)
-             ENDDO
-            ENDDO
-          ENDDO
-
-          DO l = 1,levs
-            ztemp(levs+1-l) = zf(l)
-          ENDDO
-
-          DO l = 1,levs
-            DO j = 1, lats
-             DO i = 1,lons
-              champd(i,j,levs+1-l) = champf(i,j,l)
-             ENDDO
-            ENDDO
-          ENDDO
-
-
-      ENDIF
-
-         IF(alloc)  DEALLOCATE(champf)
-
-         DO i = 1, lons
-           xf(i) = xtemp(i)
-         ENDDO
-         DO j = 1, lats
-           yf(j) = ytemp(j)
-         ENDDO
-         DO l = 1, levs
-           zf(l) = ztemp(l)
-         ENDDO
-
-      DEALLOCATE(xtemp)
-      DEALLOCATE(ytemp)
-      DEALLOCATE(ztemp)
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F	(revision 1999)
@@ -944,10 +944,4 @@
       ok_etat0 = .TRUE.
       CALL getin('ok_etat0',ok_etat0)
-
-!Config  Key  = grilles_gcm_netcdf
-!Config  Desc = creation de fichier grilles_gcm.nc dans create_etat0_limit
-!Config  Def  = n
-      grilles_gcm_netcdf = .FALSE.
-      CALL getin('grilles_gcm_netcdf',grilles_gcm_netcdf)
 
       write(lunout,*)' #########################################'
@@ -999,5 +993,4 @@
       write(lunout,*)' ok_limit = ', ok_limit
       write(lunout,*)' ok_etat0 = ', ok_etat0
-      write(lunout,*)' grilles_gcm_netcdf = ', grilles_gcm_netcdf
 c
       RETURN
Index: LMDZ5/branches/testing/libf/dyn3dmem/conf_planete.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/conf_planete.F90	(revision 1910)
+++ 	(revision )
@@ -1,70 +1,0 @@
-!
-! $Id$
-!
-SUBROUTINE conf_planete
-!
-#ifdef CPP_IOIPSL
-USE IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-USE ioipsl_getincom
-#endif
-IMPLICIT NONE
-!
-!
-!   Declarations :
-!   --------------
-#include "dimensions.h"
-#include "comconst.h"
-#include "comvert.h"
-!
-!   local:
-!   ------
-
-! ---------------------------------------------
-! Initialisations de constantes de la dynamique
-! ---------------------------------------------
-! Pi
-pi=2.*asin(1.)
-
-!Reference surface pressure (Pa)
-preff=101325.
-CALL getin('preff', preff)
-! Reference pressure at which hybrid coord. become purely pressure
-! pa=50000.
-pa=preff/2.
-CALL getin('pa', pa)
-! Gravity
-g=9.80665
-CALL getin('g',g)
-! Molar mass of the atmosphere
-molmass = 28.9644
-CALL getin('molmass',molmass)
-! kappa=R/Cp et Cp      
-kappa = 2./7.
-CALL getin('kappa',kappa)
-cpp=8.3145/molmass/kappa*1000.
-CALL getin('cpp',cpp)
-! Radius of the planet
-rad = 6371229. 
-CALL getin('radius',rad)
-! Length of a standard day (s)
-daysec=86400.
-CALL getin('daysec',daysec)
-! Rotation rate of the planet:
-! Length of a solar day, in standard days
-daylen = 1.
-CALL getin('daylen',daylen)
-! Number of days (standard) per year:
-year_day = 365.25
-CALL getin('year_day',year_day)
-! Omega
-! omeg=2.*pi/86400.
-omeg=2.*pi/daysec*(1./daylen+1./year_day)
-CALL getin('omeg',omeg)
-
-! Intrinsic heat flux (default: none) (only used if planet_type="giant")
-ihf = 0.
-call getin('ihf',ihf)
-
-END SUBROUTINE conf_planete
Index: LMDZ5/branches/testing/libf/dyn3dmem/control_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/control_mod.F90	(revision 1910)
+++ 	(revision )
@@ -1,27 +1,0 @@
-!
-! $Id$
-!
-
-MODULE control_mod
-
-! LF 01/2010
-! Remplacement du fichier et common control
-
-  IMPLICIT NONE
-
-  REAL    :: periodav, starttime
-  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
-  INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy
-  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
-  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  ! output zonal transports in dynzon.nc file
-  LOGICAL ok_dyn_ins ! output instantaneous values of fields
-                     ! in the dynamics in NetCDF files dyn_hist*nc
-  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
-                     ! in NetCDF files dyn_hist*ave.nc
-
-END MODULE
Index: LMDZ5/branches/testing/libf/dyn3dmem/convflu.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/convflu.F	(revision 1910)
+++ 	(revision )
@@ -1,62 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE convflu( 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
-      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
-      REAL       SSUM
-c
-c
-#include "comgeom.h"
-c
-      DO 5 l = 1,nbniv
-c
-      DO 2  ij = iip2, ip1jm - 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 = iip2,ip1jm,iip1
-      convfl( ij,l ) = convfl( ij + iim,l )
-   3  CONTINUE
-c
-c     ......  calcul aux poles  .......
-c
-      convpn =   SSUM( iim, yflu(     1    ,l ),  1 )
-      convps = - SSUM( iim, yflu( ip1jm-iim,l ),  1 )
-      DO 4 ij = 1,iip1
-      convfl(     ij   ,l ) = convpn * aire(   ij     ) / apoln
-      convfl( ij+ ip1jm,l ) = convps * aire( ij+ ip1jm) / apols
-   4  CONTINUE
-c
-   5  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/convmas.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/convmas.F	(revision 1910)
+++ 	(revision )
@@ -1,63 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE convmas (pbaru, pbarv, convm )
-c
-      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 ),convm(  ip1jmp1,llm )
-      INTEGER   l,ij
-
-
-c-----------------------------------------------------------------------
-c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
-
-      CALL  convflu( pbaru, pbarv, llm, convm )
-
-c-----------------------------------------------------------------------
-c   filtrage:
-c   ---------
-
-       CALL filtreg( convm, jjp1, llm, 2, 2, .true., 1 )
-
-c    integration de la convergence de masse de haut  en bas ......
-
-      DO      l      = llmm1, 1, -1
-        DO    ij     = 1, ip1jmp1
-         convm(ij,l) = convm(ij,l) + convm(ij,l+1)
-        ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/coordij.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/coordij.F	(revision 1910)
+++ 	(revision )
@@ -1,48 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE coordij(lon,lat,ilon,jlat)
-
-c=======================================================================
-c
-c   calcul des coordonnees i et j de la maille scalaire dans
-c   laquelle se trouve le point (lon,lat) en radian
-c
-c=======================================================================
-
-      IMPLICIT NONE
-      REAL lon,lat
-      INTEGER ilon,jlat
-      INTEGER i,j
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "serre.h"
-
-      real zlon,zlat
-
-      zlon=lon*pi/180.
-      zlat=lat*pi/180.
-
-      DO i=1,iim+1
-         IF (rlonu(i).GT.zlon) THEN
-            ilon=i
-            GOTO 10
-         ENDIF
-      ENDDO
-10    CONTINUE
-
-      j=0
-      DO j=1,jjm
-         IF(rlatv(j).LT.zlat) THEN
-            jlat=j
-            GOTO 20
-         ENDIF
-      ENDDO
-20    CONTINUE
-      IF(j.EQ.0) j=jjm+1
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/covcont.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/covcont.F	(revision 1910)
+++ 	(revision )
@@ -1,43 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE covcont (klevel,ucov, vcov, ucont, vcont )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c  *********************************************************************
-c    calcul des compos. contravariantes 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 ucont( ip1jmp1,klevel ), vcont( ip1jm,klevel )
-      INTEGER   l,ij
-
-
-      DO 10 l = 1,klevel
-
-      DO 2  ij = iip2, ip1jm
-      ucont( ij,l ) = ucov( ij,l ) * unscu2( ij )
-   2  CONTINUE
-
-      DO 4 ij = 1,ip1jm
-      vcont( ij,l ) = vcov( ij,l ) * unscv2( ij )
-   4  CONTINUE
-
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/defrun.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/defrun.F	(revision 1910)
+++ 	(revision )
@@ -1,497 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
-c
-      USE control_mod
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c     Auteurs :   L. Fairhead , P. Le Van  .
-c
-c     Arguments :
-c
-c     tapedef   :
-c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
-c     -metres  du zoom  avec  celles lues sur le fichier start .
-c      clesphy0 :  sortie  .
-c
-       LOGICAL etatinit
-       INTEGER tapedef
-
-       INTEGER        longcles
-       PARAMETER(     longcles = 20 )
-       REAL clesphy0( longcles )
-c
-c   Declarations :
-c   --------------
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "serre.h"
-#include "comdissnew.h"
-#include "clesph0.h"
-c
-c
-c   local:
-c   ------
-
-      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
-      INTEGER   tapeout
-      REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy,tauxx,tauyy
-      LOGICAL  fxyhypbb, ysinuss
-      INTEGER i
-      
-c
-c  -------------------------------------------------------------------
-c
-c       .........     Version  du 29/04/97       ..........
-c
-c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
-c      tetatemp   ajoutes  pour la dissipation   .
-c
-c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb ** 
-c
-c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
-c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
-c
-c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
-c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
-c                de limit.dat ( dic)                        ...........
-c           Sinon  etatinit = . FALSE .
-c
-c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
-c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
-c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
-c    lectba .  
-c   Ces parmetres definissant entre autres la grille et doivent etre
-c   pareils et coherents , sinon il y aura  divergence du gcm .
-c
-c-----------------------------------------------------------------------
-c   initialisations:
-c   ----------------
-
-      tapeout = 6
-
-c-----------------------------------------------------------------------
-c  Parametres de controle du run:
-c-----------------------------------------------------------------------
-
-      OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
-
-
-      READ (tapedef,9000) ch1,ch2,ch3
-      WRITE(tapeout,9000) ch1,ch2,ch3
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dayref
-      WRITE(tapeout,9001) ch1,'dayref'
-      WRITE(tapeout,*)    dayref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    anneeref
-      WRITE(tapeout,9001) ch1,'anneeref'
-      WRITE(tapeout,*)    anneeref
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nday
-      WRITE(tapeout,9001) ch1,'nday'
-      WRITE(tapeout,*)    nday
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    day_step
-      WRITE(tapeout,9001) ch1,'day_step'
-      WRITE(tapeout,*)    day_step
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iperiod
-      WRITE(tapeout,9001) ch1,'iperiod'
-      WRITE(tapeout,*)    iperiod
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iapp_tracvl
-      WRITE(tapeout,9001) ch1,'iapp_tracvl'
-      WRITE(tapeout,*)    iapp_tracvl
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iconser
-      WRITE(tapeout,9001) ch1,'iconser'
-      WRITE(tapeout,*)    iconser
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iecri
-      WRITE(tapeout,9001) ch1,'iecri'
-      WRITE(tapeout,*)    iecri
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    periodav
-      WRITE(tapeout,9001) ch1,'periodav'
-      WRITE(tapeout,*)    periodav
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dissip_period
-      WRITE(tapeout,9001) ch1,'dissip_period'
-      WRITE(tapeout,*)    dissip_period
-
-ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
-ccc
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    lstardis
-      WRITE(tapeout,9001) ch1,'lstardis'
-      WRITE(tapeout,*)    lstardis
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergdiv
-      WRITE(tapeout,9001) ch1,'nitergdiv'
-      WRITE(tapeout,*)    nitergdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nitergrot
-      WRITE(tapeout,9001) ch1,'nitergrot'
-      WRITE(tapeout,*)    nitergrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    niterh
-      WRITE(tapeout,9001) ch1,'niterh'
-      WRITE(tapeout,*)    niterh
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagdiv
-      WRITE(tapeout,9001) ch1,'tetagdiv'
-      WRITE(tapeout,*)    tetagdiv
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetagrot
-      WRITE(tapeout,9001) ch1,'tetagrot'
-      WRITE(tapeout,*)    tetagrot
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tetatemp
-      WRITE(tapeout,9001) ch1,'tetatemp'
-      WRITE(tapeout,*)    tetatemp
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    coefdis
-      WRITE(tapeout,9001) ch1,'coefdis'
-      WRITE(tapeout,*)    coefdis
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    purmats
-      WRITE(tapeout,9001) ch1,'purmats'
-      WRITE(tapeout,*)    purmats
-
-c    ...............................................................
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_phys
-      WRITE(tapeout,9001) ch1,'iflag_phys'
-      WRITE(tapeout,*)    iflag_phys
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iphysiq
-      WRITE(tapeout,9001) ch1,'iphysiq'
-      WRITE(tapeout,*)    iphysiq
-
-
-ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    cycle_diurne
-      WRITE(tapeout,9001) ch1,'cycle_diurne'
-      WRITE(tapeout,*)    cycle_diurne
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    soil_model
-      WRITE(tapeout,9001) ch1,'soil_model'
-      WRITE(tapeout,*)    soil_model
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    new_oliq
-      WRITE(tapeout,9001) ch1,'new_oliq'
-      WRITE(tapeout,*)    new_oliq
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orodr
-      WRITE(tapeout,9001) ch1,'ok_orodr'
-      WRITE(tapeout,*)    ok_orodr
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_orolf
-      WRITE(tapeout,9001) ch1,'ok_orolf'
-      WRITE(tapeout,*)    ok_orolf
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ok_limitvrai
-      WRITE(tapeout,9001) ch1,'ok_limitvrai'
-      WRITE(tapeout,*)    ok_limitvrai
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    nbapp_rad
-      WRITE(tapeout,9001) ch1,'nbapp_rad'
-      WRITE(tapeout,*)    nbapp_rad
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    iflag_con
-      WRITE(tapeout,9001) ch1,'iflag_con'
-      WRITE(tapeout,*)    iflag_con
-
-      DO i = 1, longcles
-       clesphy0(i) = 0.
-      ENDDO
-                          clesphy0(1) = REAL( iflag_con )
-                          clesphy0(2) = REAL( nbapp_rad )
-
-       IF( cycle_diurne  ) clesphy0(3) =  1.
-       IF(   soil_model  ) clesphy0(4) =  1.
-       IF(     new_oliq  ) clesphy0(5) =  1.
-       IF(     ok_orodr  ) clesphy0(6) =  1.
-       IF(     ok_orolf  ) clesphy0(7) =  1.
-       IF(  ok_limitvrai ) clesphy0(8) =  1.
-
-
-ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
-c     .........   (  modif  le 17/04/96 )   .........
-c
-      IF( etatinit ) GO TO 100
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clonn
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clonn
-      IF( ABS(clon - clonn).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clatt
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clatt
-
-      IF( ABS(clat - clatt).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
-     *rente de  celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismxx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismxx
-
-      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismyy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismyy
-
-      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
-     , differente de celle lue sur le fichier  start '
-        STOP
-      ENDIF
-      
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-c    alphax et alphay sont les anciennes formulat. des grossissements
-c
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypbb
-      WRITE(tapeout,9001) ch1,'fxyhypbb'
-      WRITE(tapeout,*)    fxyhypbb
-
-      IF( .NOT.fxyhypb )  THEN
-           IF( fxyhypbb )     THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
-     *,      '                   alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-      ELSE
-           IF( .NOT.fxyhypbb )   THEN
-            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
-            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
-     *,      '                   alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-      ENDIF
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomxx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomyy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomyy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauxx
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    tauxx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauyy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauyy
-
-      IF( fxyhypb )  THEN
-
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
-     *ferente de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de taux passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
-        WRITE(6,*)' La valeur de tauy passee par run.def est differente
-     *  de celle lue sur le fichier  start '
-        CALL ABORT
-       ENDIF
-
-      ENDIF
-      
-cc
-      IF( .NOT.fxyhypb  )  THEN
-        READ (tapedef,9001) ch1,ch4
-        READ (tapedef,*)    ysinuss
-        WRITE(tapeout,9001) ch1,'ysinus'
-        WRITE(tapeout,*)    ysinuss
-
-
-        IF( .NOT.ysinus )  THEN
-           IF( ysinuss )     THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
-     *       ' alors  qu il est  T  sur  run.def  ***'
-              STOP
-           ENDIF
-        ELSE
-           IF( .NOT.ysinuss )   THEN
-              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
-              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
-     *       ' alors  qu il est  F  sur  run.def  ***'
-              STOP
-           ENDIF
-        ENDIF
-      ENDIF
-c
-      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
-
-      CLOSE(tapedef)
-
-      RETURN
-c   ...............................................
-c
-100   CONTINUE
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clon
-      WRITE(tapeout,9001) ch1,'clon'
-      WRITE(tapeout,*)    clon
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    clat
-      WRITE(tapeout,9001) ch1,'clat'
-      WRITE(tapeout,*)    clat
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismx
-      WRITE(tapeout,9001) ch1,'grossismx'
-      WRITE(tapeout,*)    grossismx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    grossismy
-      WRITE(tapeout,9001) ch1,'grossismy'
-      WRITE(tapeout,*)    grossismy
-
-      IF( grossismx.LT.1. )  THEN
-        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
-         STOP
-      ELSE
-         alphax = 1. - 1./ grossismx
-      ENDIF
-
-      IF( grossismy.LT.1. )  THEN
-        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
-         STOP
-      ELSE
-         alphay = 1. - 1./ grossismy
-      ENDIF
-
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    fxyhypb
-      WRITE(tapeout,9001) ch1,'fxyhypb'
-      WRITE(tapeout,*)    fxyhypb
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomx
-      WRITE(tapeout,9001) ch1,'dzoomx'
-      WRITE(tapeout,*)    dzoomx
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    dzoomy
-      WRITE(tapeout,9001) ch1,'dzoomy'
-      WRITE(tapeout,*)    dzoomy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    taux
-      WRITE(tapeout,9001) ch1,'taux'
-      WRITE(tapeout,*)    taux
-c
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    tauy
-      WRITE(tapeout,9001) ch1,'tauy'
-      WRITE(tapeout,*)    tauy
-
-      READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    ysinus
-      WRITE(tapeout,9001) ch1,'ysinus'
-      WRITE(tapeout,*)    ysinus
-       
-      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
-c
-9000  FORMAT(3(/,a72))
-9001  FORMAT(/,a72,/,a12)
-cc
-      CLOSE(tapedef)
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/description.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/description.h	(revision 1910)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      character (len=120) :: descript
-      common /titre/descript
Index: LMDZ5/branches/testing/libf/dyn3dmem/diagedyn.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/diagedyn.F	(revision 1910)
+++ 	(revision )
@@ -1,321 +1,0 @@
-!
-! $Id: diagedyn.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-
-C======================================================================
-      SUBROUTINE diagedyn(tit,iprt,idiag,idiag2,dtime
-     e  , ucov    , vcov , ps, p ,pk , teta , q, ql)
-C======================================================================
-C
-C Purpose:
-C    Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
-C    et calcul le flux de chaleur et le flux d'eau necessaire a ces 
-C    changements. Ces valeurs sont moyennees sur la surface de tout
-C    le globe et sont exprime en W/2 et kg/s/m2
-C    Outil pour diagnostiquer la conservation de l'energie
-C    et de la masse dans la dynamique.
-C
-C
-c======================================================================
-C Arguments: 
-C tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
-C iprt----input-I-  PRINT level ( <=1 : no PRINT)
-C idiag---input-I- indice dans lequel sera range les nouveaux
-C                  bilans d' entalpie et de masse
-C idiag2--input-I-les nouveaux bilans d'entalpie et de masse 
-C                 sont compare au bilan de d'enthalpie de masse de
-C                 l'indice numero idiag2 
-C                 Cas parriculier : si idiag2=0, pas de comparaison, on
-c                 sort directement les bilans d'enthalpie et de masse 
-C dtime----input-R- time step (s)
-C uconv, vconv-input-R- vents covariants (m/s)
-C ps-------input-R- Surface pressure (Pa)
-C p--------input-R- pressure at the interfaces
-C pk-------input-R- pk= (p/Pref)**kappa
-c teta-----input-R- potential temperature (K)
-c q--------input-R- vapeur d'eau (kg/kg)
-c ql-------input-R- liquid watter (kg/kg)
-c aire-----input-R- mesh surafce (m2)
-c
-C the following total value are computed by UNIT of earth surface
-C
-C d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy 
-c            change (J/m2) during one time step (dtime) for the whole 
-C            atmosphere (air, watter vapour, liquid and solid)
-C d_qt------output-R- total water mass flux (kg/m2/s) defined as the 
-C           total watter (kg/m2) change during one time step (dtime),
-C d_qw------output-R- same, for the watter vapour only (kg/m2/s)
-C d_ql------output-R- same, for the liquid watter only (kg/m2/s)
-C d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
-C
-C
-C J.L. Dufresne, July 2002
-c======================================================================
- 
-      IMPLICIT NONE
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "iniprint.h"
-
-#ifdef CPP_EARTH
-#include "../phylmd/YOMCST.h"
-#include "../phylmd/YOETHF.h"
-#endif
-C
-      INTEGER imjmp1
-      PARAMETER( imjmp1=iim*jjp1)
-c     Input variables
-      CHARACTER*15 tit
-      INTEGER iprt,idiag, idiag2
-      REAL dtime
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL ps(ip1jmp1)                       ! pression  au sol
-      REAL p (ip1jmp1,llmp1  )  ! pression aux interfac.des couches
-      REAL pk (ip1jmp1,llm  )  ! = (p/Pref)**kappa
-      REAL teta(ip1jmp1,llm)                 ! temperature potentielle 
-      REAL q(ip1jmp1,llm)               ! champs eau vapeur
-      REAL ql(ip1jmp1,llm)               ! champs eau liquide
-
-
-c     Output variables
-      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
-C
-C     Local variables
-c
-      REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
-     .  , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
-c h_vcol_tot--  total enthalpy of vertical air column 
-C            (air with watter vapour, liquid and solid) (J/m2)
-c h_dair_tot-- total enthalpy of dry air (J/m2)
-c h_qw_tot----  total enthalpy of watter vapour (J/m2)
-c h_ql_tot----  total enthalpy of liquid watter (J/m2)
-c h_qs_tot----  total enthalpy of solid watter  (J/m2)
-c qw_tot------  total mass of watter vapour (kg/m2)
-c ql_tot------  total mass of liquid watter (kg/m2)
-c qs_tot------  total mass of solid watter (kg/m2)
-c ec_tot------  total cinetic energy (kg/m2)
-C
-      REAL masse(ip1jmp1,llm)                ! masse d'air
-      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
-      REAL ecin(ip1jmp1,llm)
-
-      REAL zaire(imjmp1)
-      REAL zps(imjmp1)
-      REAL zairm(imjmp1,llm)
-      REAL zecin(imjmp1,llm)
-      REAL zpaprs(imjmp1,llm)
-      REAL zpk(imjmp1,llm)
-      REAL zt(imjmp1,llm)
-      REAL zh(imjmp1,llm)
-      REAL zqw(imjmp1,llm)
-      REAL zql(imjmp1,llm)
-      REAL zqs(imjmp1,llm)
-
-      REAL  zqw_col(imjmp1)
-      REAL  zql_col(imjmp1)
-      REAL  zqs_col(imjmp1)
-      REAL  zec_col(imjmp1)
-      REAL  zh_dair_col(imjmp1)
-      REAL  zh_qw_col(imjmp1), zh_ql_col(imjmp1), zh_qs_col(imjmp1)
-C
-      REAL      d_h_dair, d_h_qw, d_h_ql, d_h_qs
-C
-      REAL airetot, zcpvap, zcwat, zcice
-C
-      INTEGER i, k, jj, ij , l ,ip1jjm1
-C
-      INTEGER ndiag     ! max number of diagnostic in parallel
-      PARAMETER (ndiag=10)
-      integer pas(ndiag)
-      save pas
-      data pas/ndiag*0/
-C     
-      REAL      h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
-     $    , h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag)
-     $    , ql_pre(ndiag), qs_pre(ndiag) , ec_pre(ndiag)
-      SAVE      h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre
-     $        , h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre
-
-
-#ifdef CPP_EARTH
-c======================================================================
-C     Compute Kinetic enrgy
-      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
-      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
-      CALL massdair( p, masse )
-c======================================================================
-C
-C
-      print*,'MAIS POURQUOI DONC DIAGEDYN NE MARCHE PAS ?'
-      return
-C     On ne garde les donnees que dans les colonnes i=1,iim
-      DO jj = 1,jjp1
-        ip1jjm1=iip1*(jj-1)
-        DO ij =  1,iim
-          i=iim*(jj-1)+ij
-          zaire(i)=aire(ij+ip1jjm1)
-          zps(i)=ps(ij+ip1jjm1)
-        ENDDO 
-      ENDDO 
-C 3D arrays
-      DO l  =  1, llm
-        DO jj = 1,jjp1
-          ip1jjm1=iip1*(jj-1)
-          DO ij =  1,iim
-            i=iim*(jj-1)+ij
-            zairm(i,l) = masse(ij+ip1jjm1,l)
-            zecin(i,l) = ecin(ij+ip1jjm1,l)
-            zpaprs(i,l) = p(ij+ip1jjm1,l)
-            zpk(i,l) = pk(ij+ip1jjm1,l)
-            zh(i,l) = teta(ij+ip1jjm1,l)
-            zqw(i,l) = q(ij+ip1jjm1,l)
-            zql(i,l) = ql(ij+ip1jjm1,l)
-            zqs(i,l) = 0.
-          ENDDO 
-        ENDDO 
-      ENDDO 
-C
-C     Reset variables
-      DO i = 1, imjmp1
-        zqw_col(i)=0.
-        zql_col(i)=0.
-        zqs_col(i)=0.
-        zec_col(i) = 0.
-        zh_dair_col(i) = 0.
-        zh_qw_col(i) = 0.
-        zh_ql_col(i) = 0.
-        zh_qs_col(i) = 0.
-      ENDDO
-C
-      zcpvap=RCPV
-      zcwat=RCW
-      zcice=RCS
-C
-C     Compute vertical sum for each atmospheric column
-C     ================================================
-      DO k = 1, llm
-        DO i = 1, imjmp1
-C         Watter mass
-          zqw_col(i) = zqw_col(i) + zqw(i,k)*zairm(i,k)
-          zql_col(i) = zql_col(i) + zql(i,k)*zairm(i,k)
-          zqs_col(i) = zqs_col(i) + zqs(i,k)*zairm(i,k)
-C         Cinetic Energy
-          zec_col(i) =  zec_col(i)
-     $        +zecin(i,k)*zairm(i,k)
-C         Air enthalpy
-          zt(i,k)= zh(i,k) * zpk(i,k) / RCPD
-          zh_dair_col(i) = zh_dair_col(i)
-     $        + RCPD*(1.-zqw(i,k)-zql(i,k)-zqs(i,k))*zairm(i,k)*zt(i,k)
-          zh_qw_col(i) = zh_qw_col(i)
-     $        + zcpvap*zqw(i,k)*zairm(i,k)*zt(i,k) 
-          zh_ql_col(i) = zh_ql_col(i)
-     $        + zcwat*zql(i,k)*zairm(i,k)*zt(i,k) 
-     $        - RLVTT*zql(i,k)*zairm(i,k)
-          zh_qs_col(i) = zh_qs_col(i)
-     $        + zcice*zqs(i,k)*zairm(i,k)*zt(i,k) 
-     $        - RLSTT*zqs(i,k)*zairm(i,k)
-
-        END DO
-      ENDDO
-C
-C     Mean over the planete surface
-C     =============================
-      qw_tot = 0.
-      ql_tot = 0.
-      qs_tot = 0.
-      ec_tot = 0.
-      h_vcol_tot = 0.
-      h_dair_tot = 0.
-      h_qw_tot = 0.
-      h_ql_tot = 0.
-      h_qs_tot = 0.
-      airetot=0.
-C
-      do i=1,imjmp1
-        qw_tot = qw_tot + zqw_col(i)
-        ql_tot = ql_tot + zql_col(i)
-        qs_tot = qs_tot + zqs_col(i)
-        ec_tot = ec_tot + zec_col(i)
-        h_dair_tot = h_dair_tot + zh_dair_col(i)
-        h_qw_tot = h_qw_tot + zh_qw_col(i)
-        h_ql_tot = h_ql_tot + zh_ql_col(i)
-        h_qs_tot = h_qs_tot + zh_qs_col(i)
-        airetot=airetot+zaire(i)
-      END DO
-C
-      qw_tot = qw_tot/airetot
-      ql_tot = ql_tot/airetot
-      qs_tot = qs_tot/airetot
-      ec_tot = ec_tot/airetot
-      h_dair_tot = h_dair_tot/airetot
-      h_qw_tot = h_qw_tot/airetot
-      h_ql_tot = h_ql_tot/airetot
-      h_qs_tot = h_qs_tot/airetot
-C
-      h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
-C
-C     Compute the change of the atmospheric state compare to the one 
-C     stored in "idiag2", and convert it in flux. THis computation
-C     is performed IF idiag2 /= 0 and IF it is not the first CALL
-c     for "idiag"
-C     ===================================
-C
-      IF ( (idiag2.gt.0) .and. (pas(idiag2) .ne. 0) ) THEN
-        d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
-        d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
-        d_h_qw   = (h_qw_tot  - h_qw_pre(idiag2)  )/dtime
-        d_h_ql   = (h_ql_tot  - h_ql_pre(idiag2)  )/dtime 
-        d_h_qs   = (h_qs_tot  - h_qs_pre(idiag2)  )/dtime 
-        d_qw     = (qw_tot    - qw_pre(idiag2)    )/dtime
-        d_ql     = (ql_tot    - ql_pre(idiag2)    )/dtime
-        d_qs     = (qs_tot    - qs_pre(idiag2)    )/dtime
-        d_ec     = (ec_tot    - ec_pre(idiag2)    )/dtime
-        d_qt = d_qw + d_ql + d_qs
-      ELSE 
-        d_h_vcol = 0.
-        d_h_dair = 0.
-        d_h_qw   = 0.
-        d_h_ql   = 0.
-        d_h_qs   = 0. 
-        d_qw     = 0.
-        d_ql     = 0.
-        d_qs     = 0.
-        d_ec     = 0.
-        d_qt     = 0.
-      ENDIF 
-C
-      IF (iprt.ge.2) THEN
-        WRITE(6,9000) tit,pas(idiag),d_qt,d_qw,d_ql,d_qs
- 9000   format('Dyn3d. Watter Mass Budget (kg/m2/s)',A15
-     $      ,1i6,10(1pE14.6))
-        WRITE(6,9001) tit,pas(idiag), d_h_vcol
- 9001   format('Dyn3d. Enthalpy Budget (W/m2) ',A15,1i6,10(F8.2))
-        WRITE(6,9002) tit,pas(idiag), d_ec
- 9002   format('Dyn3d. Cinetic Energy Budget (W/m2) ',A15,1i6,10(F8.2))
-C        WRITE(6,9003) tit,pas(idiag), ec_tot
- 9003   format('Dyn3d. Cinetic Energy (W/m2) ',A15,1i6,10(E15.6))
-        WRITE(6,9004) tit,pas(idiag), d_h_vcol+d_ec
- 9004   format('Dyn3d. Total Energy Budget (W/m2) ',A15,1i6,10(F8.2))
-      END IF 
-C
-C     Store the new atmospheric state in "idiag"
-C
-      pas(idiag)=pas(idiag)+1
-      h_vcol_pre(idiag)  = h_vcol_tot
-      h_dair_pre(idiag) = h_dair_tot
-      h_qw_pre(idiag)   = h_qw_tot
-      h_ql_pre(idiag)   = h_ql_tot
-      h_qs_pre(idiag)   = h_qs_tot
-      qw_pre(idiag)     = qw_tot
-      ql_pre(idiag)     = ql_tot
-      qs_pre(idiag)     = qs_tot
-      ec_pre (idiag)    = ec_tot
-C
-#else
-      write(lunout,*)'diagedyn: Needs Earth physics to function'
-#endif
-! #endif of #ifdef CPP_EARTH 
-      RETURN 
-      END 
Index: LMDZ5/branches/testing/libf/dyn3dmem/dissip_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/dissip_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/dissip_loc.F	(revision 1999)
@@ -1,7 +1,10 @@
+!
+! $Id: $
+!
       SUBROUTINE dissip_loc( vcov,ucov,teta,p, dv,du,dh )
 c
       USE parallel_lmdz
       USE write_field_loc
-      USE dissip_mod
+      USE dissip_mod, ONLY: dissip_allocate
       IMPLICIT NONE
 
@@ -35,8 +38,12 @@
 c   ----------
 
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-      REAL teta(ijb_u:ije_u,llm)
-      REAL  p( ijb_u:ije_u,llmp1 )
-      REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm),dh(ijb_u:ije_u,llm)
+      REAL,INTENT(IN) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
+      REAL,INTENT(IN) :: ucov(ijb_u:ije_u,llm) ! covariant zonal wind
+      REAL,INTENT(IN) :: teta(ijb_u:ije_u,llm) ! potential temperature
+      REAL,INTENT(IN) :: p(ijb_u:ije_u,llmp1) ! interlayer pressure
+      ! tendencies (.../s) on covariant winds and potential temperature
+      REAL,INTENT(OUT) :: dv(ijb_v:ije_v,llm)
+      REAL,INTENT(OUT) :: du(ijb_u:ije_u,llm)
+      REAL,INTENT(OUT) :: dh(ijb_u:ije_u,llm)
 
 c   Local:
Index: LMDZ5/branches/testing/libf/dyn3dmem/disvert.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/disvert.F90	(revision 1910)
+++ 	(revision )
@@ -1,180 +1,0 @@
-! $Id: disvert.F90 1645 2012-07-30 16:01:50Z lguez $
-
-SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,scaleheight)
-
-  ! Auteur : P. Le Van
-
-  use new_unit_m, only: new_unit
-  use ioipsl, only: getin
-  use assert_m, only: assert
-
-  IMPLICIT NONE
-
-  include "dimensions.h"
-  include "paramet.h"
-  include "iniprint.h"
-  include "logic.h"
-
-  ! s = sigma ** kappa : coordonnee verticale
-  ! dsig(l) : epaisseur de la couche l ds la coord. s
-  ! sig(l) : sigma a l'interface des couches l et l-1
-  ! ds(l) : distance entre les couches l et l-1 en coord.s
-
-  real,intent(in) :: pa, preff
-  real,intent(out) :: ap(llmp1) ! in Pa
-  real, intent(out):: bp(llmp1)
-  real,intent(out) :: dpres(llm), nivsigs(llm), nivsig(llmp1)
-  real,intent(out) :: presnivs(llm)
-  real,intent(out) :: scaleheight
-
-  REAL sig(llm+1), dsig(llm)
-  real zk, zkm1, dzk1, dzk2, k0, k1
-
-  INTEGER l, unit
-  REAL dsigmin
-  REAL alpha, beta, deltaz
-  REAL x
-  character(len=*),parameter :: modname="disvert"
-
-  character(len=6):: vert_sampling
-  ! (allowed values are "param", "tropo", "strato" and "read")
-
-  !-----------------------------------------------------------------------
-
-  print *, "Call sequence information: disvert"
-
-  ! default scaleheight is 8km for earth
-  scaleheight=8.
-
-  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
-  call getin('vert_sampling', vert_sampling)
-  print *, 'vert_sampling = ' // vert_sampling
-
-  select case (vert_sampling)
-  case ("param")
-     ! On lit les options dans sigma.def:
-     OPEN(99, file='sigma.def', status='old', form='formatted')
-     READ(99, *) scaleheight ! hauteur d'echelle 8.
-     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
-     READ(99, *) beta ! facteur d'acroissement en haut 1.3
-     READ(99, *) k0 ! nombre de couches dans la transition surf
-     READ(99, *) k1 ! nombre de couches dans la transition haute
-     CLOSE(99)
-     alpha=deltaz/(llm*scaleheight)
-     write(lunout, *)trim(modname),':scaleheight, alpha, k0, k1, beta', &
-                               scaleheight, alpha, k0, k1, beta
-
-     alpha=deltaz/tanh(1./k0)*2.
-     zkm1=0.
-     sig(1)=1.
-     do l=1, llm
-        sig(l+1)=(cosh(l/k0))**(-alpha*k0/scaleheight) &
-             *exp(-alpha/scaleheight*tanh((llm-k1)/k0) &
-                  *beta**(l-(llm-k1))/log(beta))
-        zk=-scaleheight*log(sig(l+1))
-
-        dzk1=alpha*tanh(l/k0)
-        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
-        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
-        zkm1=zk
-     enddo
-
-     sig(llm+1)=0.
-
-     bp(: llm) = EXP(1. - 1. / sig(: llm)**2)
-     bp(llmp1) = 0.
-
-     ap = pa * (sig - bp)
-  case("tropo")
-     DO l = 1, llm
-        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
-        dsig(l) = 1.0 + 7.0 * SIN(x)**2
-     ENDDO
-     dsig = dsig / sum(dsig)
-     sig(llm+1) = 0.
-     DO l = llm, 1, -1
-        sig(l) = sig(l+1) + dsig(l)
-     ENDDO
-
-     bp(1)=1.
-     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
-     bp(llmp1) = 0.
-
-     ap(1)=0.
-     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
-  case("strato")
-     if (llm==39) then
-        dsigmin=0.3
-     else if (llm==50) then
-        dsigmin=1.
-     else
-        write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster'
-        dsigmin=1.
-     endif
-     WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
-
-     DO l = 1, llm
-        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
-        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
-             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
-     ENDDO
-     dsig = dsig / sum(dsig)
-     sig(llm+1) = 0.
-     DO l = llm, 1, -1
-        sig(l) = sig(l+1) + dsig(l)
-     ENDDO
-
-     bp(1)=1.
-     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
-     bp(llmp1) = 0.
-
-     ap(1)=0.
-     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
-  case("read")
-     ! Read "ap" and "bp". First line is skipped (title line). "ap"
-     ! should be in Pa. First couple of values should correspond to
-     ! the surface, that is : "bp" should be in descending order.
-     call new_unit(unit)
-     open(unit, file="hybrid.txt", status="old", action="read", &
-          position="rewind")
-     read(unit, fmt=*) ! skip title line
-     do l = 1, llm + 1
-        read(unit, fmt=*) ap(l), bp(l)
-     end do
-     close(unit)
-     call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &
-          bp(llm + 1) == 0., "disvert: bad ap or bp values")
-  case default
-     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
-  END select
-
-  DO l=1, llm
-     nivsigs(l) = REAL(l)
-  ENDDO
-
-  DO l=1, llmp1
-     nivsig(l)= REAL(l)
-  ENDDO
-
-  write(lunout, *)  trim(modname),': BP '
-  write(lunout, *) bp
-  write(lunout, *)  trim(modname),': AP '
-  write(lunout, *) ap
-
-  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
-  write(lunout, *)'couches calcules pour une pression de surface =', preff
-  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de '
-  write(lunout, *) scaleheight,' km'
-  DO l = 1, llm
-     dpres(l) = bp(l) - bp(l+1)
-     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
-     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
-          log(preff/presnivs(l))*scaleheight &
-          , ' DZ ~ ', scaleheight*log((ap(l)+bp(l)*preff)/ &
-          max(ap(l+1)+bp(l+1)*preff, 1.e-10))
-  ENDDO
-
-  write(lunout, *) trim(modname),': PRESNIVS '
-  write(lunout, *) presnivs
-
-END SUBROUTINE disvert
Index: LMDZ5/branches/testing/libf/dyn3dmem/disvert_noterre.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/disvert_noterre.F	(revision 1910)
+++ 	(revision )
@@ -1,330 +1,0 @@
-! $Id$
-      SUBROUTINE disvert_noterre
-
-c    Auteur :  F. Forget Y. Wanherdrick, P. Levan
-c    Nouvelle version 100% Mars !!
-c    On l'utilise aussi pour Venus et Titan, legerment modifiee.
-
-#ifdef CPP_IOIPSL
-      use IOIPSL
-#else
-! if not using IOIPSL, we still need to use (a local version of) getin
-      use ioipsl_getincom
-#endif
-
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "logic.h"
-#include "iniprint.h"
-c
-c=======================================================================
-c    Discretisation verticale en coordonnée hybride (ou sigma)
-c
-c=======================================================================
-c
-c   declarations:
-c   -------------
-c
-c
-      INTEGER l,ll
-      REAL snorm
-      REAL alpha,beta,gama,delta,deltaz
-      real quoi,quand
-      REAL zsig(llm),sig(llm+1)
-      INTEGER np,ierr
-      integer :: ierr1,ierr2,ierr3,ierr4
-      REAL x
-
-      REAL SSUM
-      EXTERNAL SSUM
-      real newsig 
-      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
-      real tt,rr,gg, prevz
-      real s(llm),dsig(llm) 
-
-      integer iz 
-      real z, ps,p
-      character(len=*),parameter :: modname="disvert_noterre"
-
-c
-c-----------------------------------------------------------------------
-c
-! Initializations:
-!      pi=2.*ASIN(1.) ! already done in iniconst
-      
-      hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates)
-      CALL getin('hybrid',hybrid)
-      write(lunout,*) trim(modname),': hybrid=',hybrid
-
-! Ouverture possible de fichiers typiquement E.T.
-
-         open(99,file="esasig.def",status='old',form='formatted',
-     s   iostat=ierr2)
-         if(ierr2.ne.0) then
-              close(99)
-              open(99,file="z2sig.def",status='old',form='formatted',
-     s        iostat=ierr4)
-         endif
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans esasig.def:
-c   ----------------------------------------
-
-      IF(ierr2.eq.0) then
-
-c        Lecture de esasig.def :
-c        Systeme peu souple, mais qui respecte en theorie
-c        La conservation de l'energie (conversion Energie potentielle
-c        <-> energie cinetique, d'apres la note de Frederic Hourdin...
-
-         write(lunout,*)'*****************************'
-         write(lunout,*)'WARNING reading esasig.def'
-         write(lunout,*)'*****************************'
-         READ(99,*) scaleheight
-         READ(99,*) dz0
-         READ(99,*) dz1
-         READ(99,*) nhaut
-         CLOSE(99)
-
-         dz0=dz0/scaleheight
-         dz1=dz1/scaleheight
-
-         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
-
-         esig=1.
-
-         do l=1,20
-            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
-         enddo
-         csig=(1./sig1-1.)/(exp(esig)-1.)
-
-         DO L = 2, llm
-            zz=csig*(exp(esig*(l-1.))-1.)
-            sig(l) =1./(1.+zz)
-     &      * tanh(.5*(llm+1-l)/nhaut)
-         ENDDO
-         sig(1)=1.
-         sig(llm+1)=0.
-         quoi      = 1. + 2.* kappa
-         s( llm )  = 1.
-         s(llm-1) = quoi
-         IF( llm.gt.2 )  THEN
-            DO  ll = 2, llm-1
-               l         = llm+1 - ll
-               quand     = sig(l+1)/ sig(l)
-               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
-            ENDDO
-         END IF
-c
-         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
-         DO l = 1, llm
-            s(l)    = s(l)/ snorm
-         ENDDO
-
-c-----------------------------------------------------------------------
-c   cas 2 on lit les options dans z2sig.def:
-c   ----------------------------------------
-
-      ELSE IF(ierr4.eq.0) then
-         write(lunout,*)'****************************'
-         write(lunout,*)'Reading z2sig.def'
-         write(lunout,*)'****************************'
-
-         READ(99,*) scaleheight
-         do l=1,llm
-            read(99,*) zsig(l)
-         end do
-         CLOSE(99)
-
-         sig(1) =1
-         do l=2,llm
-           sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) + 
-     &                      exp(-zsig(l-1)/scaleheight) )
-         end do
-         sig(llm+1) =0
-
-c-----------------------------------------------------------------------
-      ELSE
-         write(lunout,*) 'didn t you forget something ??? '
-         write(lunout,*) 'We need file  z2sig.def ! (OR esasig.def)'
-         stop
-      ENDIF
-c-----------------------------------------------------------------------
-
-      DO l=1,llm
-        nivsigs(l) = REAL(l)
-      ENDDO
-
-      DO l=1,llmp1
-        nivsig(l)= REAL(l)
-      ENDDO
-
- 
-c-----------------------------------------------------------------------
-c    ....  Calculs  de ap(l) et de bp(l)  ....
-c    .........................................
-c
-c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
-c-----------------------------------------------------------------------
-c
-
-      if (hybrid) then  ! use hybrid coordinates
-         write(lunout,*) "*********************************"
-         write(lunout,*) "Using hybrid vertical coordinates"
-         write(lunout,*) 
-c        Coordonnees hybrides avec mod
-         DO l = 1, llm
-
-         call sig_hybrid(sig(l),pa,preff,newsig)
-            bp(l) = EXP( 1. - 1./(newsig**2)  )
-            ap(l) = pa * (newsig - bp(l) )
-         enddo
-         bp(llmp1) = 0.
-         ap(llmp1) = 0.
-      else ! use sigma coordinates
-         write(lunout,*) "********************************"
-         write(lunout,*) "Using sigma vertical coordinates"
-         write(lunout,*) 
-c        Pour ne pas passer en coordonnees hybrides
-         DO l = 1, llm
-            ap(l) = 0.
-            bp(l) = sig(l)
-         ENDDO
-         ap(llmp1) = 0.
-      endif
-
-      bp(llmp1) =   0.
-
-      write(lunout,*) trim(modname),': BP '
-      write(lunout,*)  bp
-      write(lunout,*) trim(modname),': AP '
-      write(lunout,*)  ap
-
-c     Calcul au milieu des couches :
-c     WARNING : le choix de placer le milieu des couches au niveau de
-c     pression intermédiaire est arbitraire et pourrait etre modifié.
-c     Le calcul du niveau pour la derniere couche 
-c     (on met la meme distance (en log pression)  entre P(llm)
-c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
-c     Specifique.  Ce choix est spécifié ici ET dans exner_milieu.F
-
-      DO l = 1, llm-1
-       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
-       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
-      ENDDO
-     
-      if (hybrid) then
-         aps(llm) = aps(llm-1)**2 / aps(llm-2) 
-         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
-      else
-         bps(llm) = bps(llm-1)**2 / bps(llm-2) 
-         aps(llm) = 0.
-      end if
-
-      write(lunout,*) trim(modname),': BPs '
-      write(lunout,*)  bps
-      write(lunout,*) trim(modname),': APs'
-      write(lunout,*)  aps
-
-      DO l = 1, llm
-       presnivs(l) = aps(l)+bps(l)*preff
-       pseudoalt(l) = -scaleheight*log(presnivs(l)/preff)
-      ENDDO
-
-      write(lunout,*)trim(modname),' : PRESNIVS' 
-      write(lunout,*)presnivs 
-      write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ',
-     &                'height of ',scaleheight,' km)' 
-      write(lunout,*)pseudoalt
-
-c     --------------------------------------------------
-c     This can be used to plot the vertical discretization
-c     (> xmgrace -nxy testhybrid.tab )
-c     --------------------------------------------------
-c     open (53,file='testhybrid.tab')
-c     scaleheight=15.5
-c     do iz=0,34
-c       z = -5 + min(iz,34-iz)
-c     approximation of scale height for Venus
-c       scaleheight = 15.5 - z/55.*10.
-c       ps = preff*exp(-z/scaleheight)
-c       zsig(1)= -scaleheight*log((aps(1) + bps(1)*ps)/preff)
-c       do l=2,llm
-c     approximation of scale height for Venus
-c          if (zsig(l-1).le.55.) then
-c             scaleheight = 15.5 - zsig(l-1)/55.*10.
-c          else
-c             scaleheight = 5.5 - (zsig(l-1)-55.)/35.*2.
-c          endif
-c          zsig(l)= zsig(l-1)-scaleheight*
-c    .    log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps))
-c       end do
-c       write(53,'(I3,50F10.5)') iz, zsig
-c      end do
-c      close(53)
-c     --------------------------------------------------
-
-
-      RETURN
-      END
-
-c ************************************************************
-      subroutine sig_hybrid(sig,pa,preff,newsig)
-c     ----------------------------------------------
-c     Subroutine utilisee pour calculer des valeurs de sigma modifie
-c     pour conserver les coordonnees verticales decrites dans
-c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
-c     F. Forget 2002
-c     Connaissant sig (niveaux "sigma" ou on veut mettre les couches)
-c     L'objectif est de calculer newsig telle que
-c       (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig
-c     Cela ne se résoud pas analytiquement: 
-c     => on résoud par iterration bourrine 
-c     ----------------------------------------------
-c     Information  : where exp(1-1./x**2) become << x
-c           x      exp(1-1./x**2) /x
-c           1           1
-c           0.68       0.5
-c           0.5        1.E-1
-c           0.391      1.E-2
-c           0.333      1.E-3
-c           0.295      1.E-4
-c           0.269      1.E-5
-c           0.248      1.E-6
-c        => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25
-
-
-      implicit none
-      real x1, x2, sig,pa,preff, newsig, F
-      integer j
-
-      newsig = sig
-      x1=0
-      x2=1
-      if (sig.ge.1) then
-            newsig= sig
-      else if (sig*preff/pa.ge.0.25) then
-        DO J=1,9999  ! nombre d''iteration max
-          F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
-c         write(0,*) J, ' newsig =', newsig, ' F= ', F
-          if (F.gt.1) then
-              X2 = newsig
-              newsig=(X1+newsig)*0.5
-          else
-              X1 = newsig
-              newsig=(X2+newsig)*0.5
-          end if
-c         Test : on arete lorsque on approxime sig à moins de 0.01 m près 
-c         (en pseudo altitude) :
-          IF(abs(10.*log(F)).LT.1.E-5) goto 999
-        END DO
-       else   !    if (sig*preff/pa.le.0.25) then
-             newsig= sig*preff/pa
-       end if
- 999   continue
-       Return
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/diverg.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/diverg.F	(revision 1910)
+++ 	(revision )
@@ -1,85 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE diverg(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  *********************************************************************
-      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
-      REAL      SSUM
-c
-c
-      DO 10 l = 1,klevel
-c
-        DO  ij = iip2, ip1jm - 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 = iip2,ip1jm,iip1
-         div( ij,l ) = div( ij + iim,l )
-        ENDDO
-c
-c     ....  calcul  aux poles  .....
-c
-        DO  ij  = 1,iim
-         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
-         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
-        ENDDO
-        sumypn = SSUM ( iim,aiy1,1 ) / apoln
-        sumyps = SSUM ( iim,aiy2,1 ) / apols
-c
-        DO  ij = 1,iip1
-         div(     ij    , l ) = - sumypn
-         div( ij + ip1jm, l ) =   sumyps
-        ENDDO
-  10  CONTINUE
-c
-
-ccc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
-      
-c
-        DO l = 1, klevel
-           DO ij = iip2,ip1jm
-            div(ij,l) = div(ij,l) * unsaire(ij) 
-          ENDDO
-        ENDDO
-c
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/diverg_gam.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/diverg_gam.F	(revision 1910)
+++ 	(revision )
@@ -1,80 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE diverg_gam(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  *********************************************************************
-      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
-      REAL      SSUM
-c
-c
-      DO 10 l = 1,klevel
-c
-        DO  ij = iip2, ip1jm - 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 = iip2,ip1jm,iip1
-         div( ij,l ) = div( ij + iim,l )
-        ENDDO
-c
-c     ....  calcul  aux poles  .....
-c
-        DO  ij  = 1,iim
-         aiy1(ij) =    cuvscvgam(    ij       ) * y(     ij     , l )
-         aiy2(ij) =    cuvscvgam( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
-        ENDDO
-        sumypn = SSUM ( iim,aiy1,1 ) * unsapolnga
-        sumyps = SSUM ( iim,aiy2,1 ) * unsapolsga
-c
-        DO  ij = 1,iip1
-         div(     ij    , l ) = - sumypn 
-         div( ij + ip1jm, l ) =   sumyps 
-        ENDDO
-  10  CONTINUE
-c
-
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/divergf.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/divergf.F	(revision 1910)
+++ 	(revision )
@@ -1,85 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE divergf(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  *********************************************************************
-      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
-      REAL      SSUM
-c
-c
-      DO 10 l = 1,klevel
-c
-        DO  ij = iip2, ip1jm - 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 = iip2,ip1jm,iip1
-         div( ij,l ) = div( ij + iim,l )
-        ENDDO
-c
-c     ....  calcul  aux poles  .....
-c
-        DO  ij  = 1,iim
-         aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
-         aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
-        ENDDO
-        sumypn = SSUM ( iim,aiy1,1 ) / apoln
-        sumyps = SSUM ( iim,aiy2,1 ) / apols
-c
-        DO  ij = 1,iip1
-         div(     ij    , l ) = - sumypn
-         div( ij + ip1jm, l ) =   sumyps
-        ENDDO
-  10  CONTINUE
-c
-
-        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
-      
-c
-        DO l = 1, klevel
-           DO ij = iip2,ip1jm
-            div(ij,l) = div(ij,l) * unsaire(ij) 
-          ENDDO
-        ENDDO
-c
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/divergst.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/divergst.F	(revision 1910)
+++ 	(revision )
@@ -1,62 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE divergst(klevel,x,y,div)
-      IMPLICIT NONE
-c
-c     P. Le Van
-c
-c  ******************************************************************
-c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos. x et y...
-c           x et y  etant des composantes contravariantes   ...
-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
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      INTEGER klevel
-      REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
-      INTEGER ij,l,i
-      REAL aiy1( iip1 ) , aiy2( iip1 )
-      REAL sumypn,sumyps
-
-      REAL SSUM
-c
-c
-      DO 10 l = 1,klevel
-c
-      DO 1 ij = iip2, ip1jm - 1
-      div( ij + 1, l ) = x(ij+1,l) - x(ij,l)+ y(ij-iim,l)-y(ij+1,l)
-   1  CONTINUE
-c
-c     ....  correction pour  div( 1,j,l)  ......
-c     ....   div(1,j,l)= div(iip1,j,l) ....
-c
-CDIR$ IVDEP
-      DO 3 ij = iip2,ip1jm,iip1
-      div( ij,l ) = div( ij + iim,l )
-   3  CONTINUE
-c
-c     ....  calcul  aux poles  .....
-c
-c
-      DO 5 i  = 1,iim
-      aiy1(i)= y(i,l)
-      aiy2(i)= y(i+ip1jmi1,l)
-   5  CONTINUE
-      sumypn = SSUM ( iim,aiy1,1 )
-      sumyps = SSUM ( iim,aiy2,1 )
-      DO 7 i = 1,iip1
-      div(     i    , l ) = - sumypn/iim
-      div( i + ip1jm, l ) =   sumyps/iim
-   7  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/divgrad.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/divgrad.F	(revision 1910)
+++ 	(revision )
@@ -1,56 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE divgrad (klevel,h, lh, divgra )
-      IMPLICIT NONE
-c
-c=======================================================================
-c
-c  Auteur :   P. Le Van
-c  ----------
-c
-c                              lh
-c      calcul de  (div( grad ))   de h  .....
-c      h  et lh  sont des arguments  d'entree pour le s-prog
-c      divgra     est  un argument  de sortie pour le s-prog
-c
-c=======================================================================
-c
-c   declarations:
-c   -------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "comdissipn.h"
-#include "logic.h"
-c
-      INTEGER klevel
-      REAL h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
-c
-      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
-
-      INTEGER  l,ij,iter,lh
-c
-c
-c
-      CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
-c
-      DO 10 iter = 1,lh
-
-      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1  )
-
-      CALL    grad (klevel,divgra, ghx  , ghy          )
-      CALL  diverg (klevel,  ghx , ghy  , divgra       )
-
-      CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
-
-      DO 5 l = 1,klevel
-      DO 4  ij = 1, ip1jmp1
-      divgra( ij,l ) = - cdivh * divgra( ij,l )
-   4  CONTINUE
-   5  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/divgrad2.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/divgrad2.F	(revision 1910)
+++ 	(revision )
@@ -1,79 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra )
-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
-      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( ip1jmp1,klevel)
-c
-c    .......    variables  locales    ..........
-c
-      REAL     signe, nudivgrs, sqrtps( ip1jmp1,llm )
-      INTEGER  l,ij,iter,lh
-c    ...................................................................
-
-c
-      signe    = (-1.)**lh
-      nudivgrs = signe * cdivh
-
-      CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
-
-c
-      CALL laplacien( klevel, divgra, divgra )
-     
-      DO l = 1, klevel
-       DO ij = 1, ip1jmp1
-        sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
-       ENDDO
-      ENDDO
-c
-      DO l = 1, klevel
-        DO ij = 1, ip1jmp1
-         divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
-        ENDDO
-      ENDDO
-   
-c    ........    Iteration de l'operateur  laplacien_gam    ........
-c
-      DO  iter = 1, lh - 2
-       CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2,
-     *                     unsapolnga2, unsapolsga2,  divgra, divgra )
-      ENDDO
-c
-c    ...............................................................
- 
-      DO l = 1, klevel
-        DO ij = 1, ip1jmp1
-          divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
-        ENDDO
-      ENDDO
-c
-      CALL laplacien ( klevel, divgra, divgra )
-c
-      DO l  = 1,klevel
-      DO ij = 1,ip1jmp1
-      divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/dump2d.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/dump2d.F	(revision 1910)
+++ 	(revision )
@@ -1,46 +1,0 @@
-!
-! $Id: dump2d.F 1279 2009-12-10 09:02:56Z fairhead $
-!
-      SUBROUTINE dump2d(im,jm,z,nom_z)
-      IMPLICIT NONE
-      INTEGER im,jm
-      REAL z(im,jm)
-      CHARACTER (len=*) :: nom_z
-
-      INTEGER i,j,imin,illm,jmin,jllm
-      REAL zmin,zllm
-
-      WRITE(*,*) "dump2d: ",trim(nom_z)
-
-      zmin=z(1,1)
-      zllm=z(1,1)
-      imin=1
-      illm=1
-      jmin=1
-      jllm=1
-
-      DO j=1,jm
-         DO i=1,im
-            IF(z(i,j).GT.zllm) THEN
-               illm=i
-               jllm=j
-               zllm=z(i,j)
-            ENDIF
-            IF(z(i,j).LT.zmin) THEN
-               imin=i
-               jmin=j
-               zmin=z(i,j)
-            ENDIF
-         ENDDO
-      ENDDO
-
-      PRINT*,'MIN: ',zmin
-      PRINT*,'MAX: ',zllm
-
-      IF(zllm.GT.zmin) THEN
-       DO j=1,jm
-        WRITE(*,'(600i1)') (NINT(10.*(z(i,j)-zmin)/(zllm-zmin)),i=1,im)
-       ENDDO
-      ENDIF
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/dynetat0_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/dynetat0_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/dynetat0_loc.F	(revision 1999)
@@ -68,5 +68,5 @@
      &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
         write(lunout,*)' ierr = ', ierr
-        CALL ABORT
+        CALL ABORT_GCM("DYNETAT0", "", 1)
       ENDIF
 
@@ -75,5 +75,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -84,5 +84,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -158,5 +158,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -167,5 +167,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -173,5 +173,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -182,5 +182,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -188,5 +188,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -197,5 +197,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -203,5 +203,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -212,5 +212,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -218,5 +218,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -227,5 +227,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -233,5 +233,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -242,5 +242,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -248,5 +248,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -257,5 +257,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
       
@@ -265,5 +265,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -274,5 +274,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
       phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
@@ -286,5 +286,5 @@
          IF (ierr .NE. NF_NOERR) THEN
             write(lunout,*)"dynetat0: Le champ <Time> est absent"
-            CALL abort
+            CALL abort_gcm("dynetat0", "", 1)
          ENDIF
       ENDIF
@@ -296,5 +296,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -302,5 +302,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
       
@@ -314,5 +314,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -324,5 +324,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -333,5 +333,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
       vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
@@ -342,5 +342,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -351,5 +351,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
@@ -375,5 +375,5 @@
             write(lunout,*)
      &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
-            CALL abort
+            CALL abort_gcm("dynetat0", "", 1)
           ENDIF
         q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
@@ -388,5 +388,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -397,5 +397,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
       masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
@@ -406,5 +406,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 #ifdef NC_DOUBLE
@@ -415,5 +415,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
-         CALL abort
+         CALL abort_gcm("dynetat0", "", 1)
       ENDIF
 
Index: LMDZ5/branches/testing/libf/dyn3dmem/dynredem_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/dynredem_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/dynredem_loc.F	(revision 1999)
@@ -138,5 +138,5 @@
      &                  //trim(fichnom)
          write(lunout,*)' ierr = ', ierr
-         CALL ABORT
+         CALL ABORT_GCM("DYNREDEM0", "", 1)
       ENDIF
 c
@@ -588,5 +588,5 @@
       IF (ierr .NE. NF_NOERR) THEN
          write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
-         CALL abort
+         CALL abort_gcm("dynredem1", "", 1)
       ENDIF
 
Index: LMDZ5/branches/testing/libf/dyn3dmem/ener.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ener.h	(revision 1910)
+++ 	(revision )
@@ -1,17 +1,0 @@
-!
-! $Id$
-!
-!  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 'ener.h'
-
-      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
-     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
-     &            rmsv,gtot(llmm1)
-      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
-     &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
-
-!-----------------------------------------------------------------------
Index: LMDZ5/branches/testing/libf/dyn3dmem/enercin.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/enercin.F	(revision 1910)
+++ 	(revision )
@@ -1,98 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE enercin ( vcov, ucov, vcont, ucont, ecin )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur: P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c *********************************************************************
-c .. calcul de l'energie cinetique aux niveaux s  ......
-c *********************************************************************
-c  vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
-c  ecin         est  un  argument de sortie pour le s-pg
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      REAL vcov( ip1jm,llm ),vcont( ip1jm,llm ),
-     * ucov( ip1jmp1,llm ),ucont( ip1jmp1,llm ),ecin( ip1jmp1,llm )
-
-      REAL ecinni( iip1 ),ecinsi( iip1 )
-
-      REAL ecinpn, ecinps
-      INTEGER     l,ij,i
-
-      REAL        SSUM
-
-
-
-c                 . V
-c                i,j-1
-
-c      alpha4 .       . alpha1
-
-
-c        U .      . P     . U
-c       i-1,j    i,j      i,j
-
-c      alpha3 .       . alpha2
-
-
-c                 . V
-c                i,j
-
-c    
-c  L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
-c       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
-c              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
-c              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
-c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
-
-
-      DO 5 l = 1,llm
-
-      DO 1  ij = iip2, ip1jm -1
-      ecin( ij+1, l )  =    0.5  *
-     * (   ucov( ij   ,l ) * ucont( ij   ,l ) * alpha3p4( ij +1 )   +
-     *     ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 )   +
-     *     vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 )   +
-     *     vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 )   )
-   1  CONTINUE
-
-c    ... correction pour  ecin(1,j,l)  ....
-c    ...   ecin(1,j,l)= ecin(iip1,j,l) ...
-
-CDIR$ IVDEP
-      DO 2 ij = iip2, ip1jm, iip1
-      ecin( ij,l ) = ecin( ij + iim, l )
-   2  CONTINUE
-
-c     calcul aux poles  .......
-
-
-      DO 3 i = 1, iim
-      ecinni(i) = vcov(    i  ,  l) * vcont(    i    ,l) * aire(   i   )
-      ecinsi(i) = vcov(i+ip1jmi1,l) * vcont(i+ip1jmi1,l) * aire(i+ip1jm)
-   3  CONTINUE
-
-      ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln
-      ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols
-
-      DO 4 ij = 1,iip1
-      ecin(   ij     , l ) = ecinpn
-      ecin( ij+ ip1jm, l ) = ecinps
-   4  CONTINUE
-
-   5  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/exner_hyb.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/exner_hyb.F	(revision 1910)
+++ 	(revision )
@@ -1,152 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE  exner_hyb ( 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
-      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
-c
-      logical,save :: firstcall=.true.
-      character(len=*),parameter :: modname="exner_hyb"
-      
-      ! Sanity check
-      if (firstcall) then
-        ! 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)
-
-      if (llm.eq.1) then
-        
-        ! Compute pks(:),pk(:),pkf(:)
-        
-        DO   ij  = 1, ngrid
-          pks(ij) = (cpp/preff) * ps(ij) 
-          pk(ij,1) = .5*pks(ij)
-        ENDDO
-        
-        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-        CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
-        
-        ! our work is done, exit routine
-        return
-
-      endif ! of if (llm.eq.1)
-
-!!!! General case:
-     
-      unpl2k    = 1.+ 2.* kappa
-c
-      DO   ij  = 1, ngrid
-        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-      ENDDO
-
-      DO  ij   = 1, iim
-        ppn(ij) = aire(   ij   ) * pks(  ij     )
-        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-      ENDDO
-      xpn      = SSUM(iim,ppn,1) /apoln
-      xps      = SSUM(iim,pps,1) /apols
-
-      DO ij   = 1, iip1
-        pks(   ij     )  =  xpn
-        pks( ij+ip1jm )  =  xps
-      ENDDO
-c
-c
-c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
-c
-      DO     ij      = 1, ngrid
-       alpha(ij,llm) = 0.
-       beta (ij,llm) = 1./ unpl2k
-      ENDDO
-c
-c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
-c
-      DO l = llm -1 , 2 , -1
-c
-        DO ij = 1, ngrid
-        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
-      ENDDO
-c
-c  ***********************************************************************
-c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
-c
-      DO   ij   = 1, ngrid
-       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
-c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
-c
-      DO l = 2, llm
-        DO   ij   = 1, ngrid
-         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
-        ENDDO
-      ENDDO
-c
-c
-      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
-      
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/exner_milieu.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/exner_milieu.F	(revision 1910)
+++ 	(revision )
@@ -1,144 +1,0 @@
-!
-! $Id$
-!
-      SUBROUTINE  exner_milieu ( 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
-      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
-      logical,save :: firstcall=.true.
-      character(len=*),parameter :: modname="exner_milieu"
-
-      ! Sanity check
-      if (firstcall) then
-        ! 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)
-
-!!!! Specific behaviour for Shallow Water (1 vertical layer) case:
-      if (llm.eq.1) then
-      
-        ! Compute pks(:),pk(:),pkf(:)
-        
-        DO   ij  = 1, ngrid
-          pks(ij) = (cpp/preff) * ps(ij) 
-          pk(ij,1) = .5*pks(ij)
-        ENDDO
-        
-        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-        CALL filtreg ( pkf, 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     -------------
-   
-      DO   ij  = 1, ngrid
-        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
-      ENDDO
-
-      DO  ij   = 1, iim
-        ppn(ij) = aire(   ij   ) * pks(  ij     )
-        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-      ENDDO
-      xpn      = SSUM(iim,ppn,1) /apoln
-      xps      = SSUM(iim,pps,1) /apols
-
-      DO ij   = 1, iip1
-        pks(   ij     )  =  xpn
-        pks( ij+ip1jm )  =  xps
-      ENDDO
-c
-c
-c    .... Calcul de pk  pour la couche l 
-c    --------------------------------------------
-c
-      dum1 = cpp * (2*preff)**(-kappa) 
-      DO l = 1, llm-1
-        DO   ij   = 1, ngrid
-         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
-        ENDDO
-      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)
-
-      DO   ij   = 1, ngrid
-         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
-      ENDDO
-
-
-c    calcul de pkf
-c    -------------
-      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
-      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
-      
-c    EST-CE UTILE ?? : calcul de beta
-c    --------------------------------
-      DO l = 2, llm
-        DO   ij   = 1, ngrid
-          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/extrapol.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/extrapol.F	(revision 1910)
+++ 	(revision )
@@ -1,200 +1,0 @@
-!
-! $Id: extrapol.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-C
-C
-      SUBROUTINE extrapol (pfild, kxlon, kylat, pmask,
-     .                   norsud, ldper, knbor, pwork)
-      IMPLICIT none
-c
-c OASIS routine (Adaptation: Laurent Li, le 14 mars 1997)
-c Fill up missed values by using the neighbor points
-c
-      INTEGER kxlon, kylat ! longitude and latitude dimensions (Input)
-      INTEGER knbor ! minimum neighbor number (Input)
-      LOGICAL norsud ! True if field is from North to South (Input)
-      LOGICAL ldper ! True if take into account the periodicity (Input)
-      REAL pmask ! mask value (Input)
-      REAL pfild(kxlon,kylat) ! field to be extrapolated (Input/Output)
-      REAL pwork(kxlon,kylat) ! working space
-c
-      REAL zwmsk
-      INTEGER incre, idoit, i, j, k, inbor, ideb, ifin, ilon, jlat
-      INTEGER ix(9), jy(9) ! index arrays for the neighbors coordinates
-      REAL zmask(9)
-C
-C  We search over the eight closest neighbors
-C
-C            j+1  7  8  9
-C              j  4  5  6    Current point 5 --> (i,j)
-C            j-1  1  2  3
-C                i-1 i i+1
-c
-c
-      IF (norsud) THEN
-         DO j = 1, kylat
-         DO i = 1, kxlon
-            pwork(i,j) = pfild(i,kylat-j+1)
-         ENDDO
-         ENDDO
-         DO j = 1, kylat
-         DO i = 1, kxlon
-            pfild(i,j) = pwork(i,j)
-         ENDDO
-         ENDDO
-      ENDIF
-c
-      incre = 0
-c
-      DO j = 1, kylat
-      DO i = 1, kxlon
-         pwork(i,j) = pfild(i,j)
-      ENDDO
-      ENDDO
-c
-C* To avoid problems in floating point tests
-      zwmsk = pmask - 1.0
-c
-200   CONTINUE
-      incre = incre + 1
-      DO 99999 j = 1, kylat
-      DO 99999 i = 1, kxlon
-      IF (pfild(i,j).GT. zwmsk) THEN
-         pwork(i,j) = pfild(i,j)
-         inbor = 0
-         ideb = 1
-         ifin = 9
-C
-C* Fill up ix array
-         ix(1) = MAX (1,i-1)
-         ix(2) = i
-         ix(3) = MIN (kxlon,i+1)
-         ix(4) = MAX (1,i-1)
-         ix(5) = i
-         ix(6) = MIN (kxlon,i+1)
-         ix(7) = MAX (1,i-1)
-         ix(8) = i
-         ix(9) = MIN (kxlon,i+1)
-C
-C* Fill up iy array
-         jy(1) = MAX (1,j-1)
-         jy(2) = MAX (1,j-1)
-         jy(3) = MAX (1,j-1)
-         jy(4) = j
-         jy(5) = j
-         jy(6) = j
-         jy(7) = MIN (kylat,j+1)
-         jy(8) = MIN (kylat,j+1)
-         jy(9) = MIN (kylat,j+1)
-C
-C* Correct latitude bounds if southernmost or northernmost points
-         IF (j .EQ. 1) ideb = 4
-         IF (j .EQ. kylat) ifin = 6
-C
-C* Account for periodicity in longitude
-C
-         IF (ldper) THEN 
-            IF (i .EQ. kxlon) THEN
-               ix(3) = 1
-               ix(6) = 1
-               ix(9) = 1
-            ELSE IF (i .EQ. 1) THEN
-               ix(1) = kxlon
-               ix(4) = kxlon
-               ix(7) = kxlon
-            ENDIF
-         ELSE
-            IF (i .EQ. 1) THEN
-               ix(1) = i
-               ix(2) = i + 1
-               ix(3) = i
-               ix(4) = i + 1
-               ix(5) = i
-               ix(6) = i + 1
-            ENDIF 
-            IF (i .EQ. kxlon) THEN
-               ix(1) = i -1
-               ix(2) = i
-               ix(3) = i - 1
-               ix(4) = i
-               ix(5) = i - 1
-               ix(6) = i
-            ENDIF
-C
-            IF (i .EQ. 1 .OR. i .EQ. kxlon) THEN 
-               jy(1) = MAX (1,j-1)
-               jy(2) = MAX (1,j-1)
-               jy(3) = j
-               jy(4) = j
-               jy(5) = MIN (kylat,j+1)
-               jy(6) = MIN (kylat,j+1)
-C
-               ideb = 1
-               ifin = 6
-               IF (j .EQ. 1) ideb = 3
-               IF (j .EQ. kylat) ifin = 4
-            ENDIF
-         ENDIF ! end for ldper test
-C
-C* Find unmasked neighbors
-C
-         DO 230 k = ideb, ifin
-            zmask(k) = 0.
-            ilon = ix(k)
-            jlat = jy(k)
-            IF (pfild(ilon,jlat) .LT. zwmsk) THEN
-               zmask(k) = 1.
-               inbor = inbor + 1
-            ENDIF
- 230     CONTINUE
-C
-C* Not enough points around point P are unmasked; interpolation on P 
-C  will be done in a future call to extrap.
-C
-         IF (inbor .GE. knbor) THEN
-            pwork(i,j) = 0.
-            DO k = ideb, ifin
-               ilon = ix(k)
-               jlat = jy(k)
-               pwork(i,j) = pwork(i,j)
-     $                      + pfild(ilon,jlat) * zmask(k)/ REAL(inbor)
-            ENDDO
-         ENDIF
-C
-      ENDIF
-99999 CONTINUE
-C
-C*    3. Writing back unmasked field in pfild
-C        ------------------------------------
-C
-C* pfild then contains:
-C     - Values which were not masked
-C     - Interpolated values from the inbor neighbors
-C     - Values which are not yet interpolated
-C
-      idoit = 0
-      DO j = 1, kylat
-      DO i = 1, kxlon
-         IF (pwork(i,j) .GT. zwmsk) idoit = idoit + 1
-         pfild(i,j) = pwork(i,j)
-      ENDDO
-      ENDDO
-c
-      IF (idoit .ne. 0) GOTO 200
-ccc      PRINT*, "Number of extrapolation steps incre =", incre
-c
-      IF (norsud) THEN
-         DO j = 1, kylat
-         DO i = 1, kxlon
-            pwork(i,j) = pfild(i,kylat-j+1)
-         ENDDO
-         ENDDO
-         DO j = 1, kylat
-         DO i = 1, kxlon
-            pfild(i,j) = pwork(i,j)
-         ENDDO
-         ENDDO
-      ENDIF
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/flumass.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/flumass.F	(revision 1910)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
-
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteurs:  P. Le Van, F. Hourdin  .
-c   -------
-c
-c   Objet:
-c   ------
-c
-c *********************************************************************
-c     .... calcul du flux de masse  aux niveaux s ......
-c *********************************************************************
-c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
-c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
-c
-c=======================================================================
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      REAL massebx( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
-     * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
-     * pbarv( ip1jm,llm )
-
-      REAL apbarun( iip1 ),apbarus( iip1 )
-
-      REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
-      INTEGER  l,ij,i
-
-      REAL       SSUM
-
-
-      DO  5 l = 1,llm
-
-      DO  1 ij = iip2,ip1jm
-      pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
-   1  CONTINUE
-
-      DO 3 ij = 1,ip1jm
-      pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
-   3  CONTINUE
-
-   5  CONTINUE
-
-c    ................................................................
-c     calcul de la composante du flux de masse en x aux poles .......
-c    ................................................................
-c     par la resolution d'1 systeme de 2 equations .
-
-c     la premiere equat.decrivant le calcul de la divergence en 1 point i
-c     du pole,ce calcul etant itere de i=1 a i=im .
-c                 c.a.d   ,
-c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
-c                                           - somme de ( pbarv(n) )/aire pole
-
-c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
-c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
-
-c     on en revient ainsi a determiner la constante additive commune aux pbaru
-c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
-c     i=1 .
-c     i variant de 1 a im
-c     n variant de 1 a im
-
-      sairen = SSUM( iim,  aire(   1     ), 1 )
-      saireun= SSUM( iim, aireu(   1     ), 1 )
-      saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
-      saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
-
-      DO 20 l = 1,llm
-
-      ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
-      cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
-
-      pbaru(    1   ,l )=   pbarv(    1     ,l ) - ctn * aire(    1    )
-      pbaru( ip1jm+1,l )= - pbarv( ip1jmi1+1,l ) + cts * aire( ip1jm+1 )
-
-      DO 11 i = 2,iim
-      pbaru(    i    ,l ) = pbaru(   i - 1   ,l )    +
-     *                      pbarv(    i      ,l ) - ctn * aire(   i    )
-
-      pbaru( i+ ip1jm,l ) = pbaru( i+ ip1jm-1,l )    -
-     *                      pbarv( i+ ip1jmi1,l ) + cts * aire(i+ ip1jm)
-  11  CONTINUE
-      DO 12 i = 1,iim
-      apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
-      apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
-  12  CONTINUE
-      ctn0 = -SSUM( iim,apbarun,1 )/saireun
-      cts0 = -SSUM( iim,apbarus,1 )/saireus
-      DO 14 i = 1,iim
-      pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
-      pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
-  14  CONTINUE
-
-      pbaru(   iip1 ,l ) = pbaru(    1    ,l )
-      pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
-  20  CONTINUE
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/fxhyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fxhyp.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/fxhyp.F	(revision 1999)
@@ -48,18 +48,18 @@
 c
        REAL   dzoom
-       REAL*8 xlon(iip1),xprimm(iip1),xuv
-       REAL*8 xtild(0:nmax2)
-       REAL*8 fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
-       REAL*8 Xf(0:nmax2),xxpr(0:nmax2)
-       REAL*8 xvrai(iip1),xxprim(iip1) 
-       REAL*8 pi,depi,epsilon,xzoom,fa,fb
-       REAL*8 Xf1, Xfi , a0,a1,a2,a3,xi2
+       REAL(KIND=8) xlon(iip1),xprimm(iip1),xuv
+       REAL(KIND=8) xtild(0:nmax2)
+       REAL(KIND=8) fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
+       REAL(KIND=8) Xf(0:nmax2),xxpr(0:nmax2)
+       REAL(KIND=8) xvrai(iip1),xxprim(iip1) 
+       REAL(KIND=8) pi,depi,epsilon,xzoom,fa,fb
+       REAL(KIND=8) Xf1, Xfi , a0,a1,a2,a3,xi2
        INTEGER i,it,ik,iter,ii,idif,ii1,ii2
-       REAL*8 xi,xo1,xmoy,xlon2,fxm,Xprimin
-       REAL*8 champmin,champmax,decalx
+       REAL(KIND=8) xi,xo1,xmoy,xlon2,fxm,Xprimin
+       REAL(KIND=8) champmin,champmax,decalx
        INTEGER is2
        SAVE is2
 
-       REAL*8 heavyside
+       REAL(KIND=8) heavyside
 
        pi       = 2. * ASIN(1.)
@@ -157,5 +157,5 @@
         WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
      , ' et relancer ! ***  '
-        CALL ABORT
+        CALL ABORT_GCM("FXHYP", "", 1)
        ENDIF
 c
@@ -290,4 +290,5 @@
          xxprim(1)   = xxprim(iip1)
        ENDIF
+
        DO i = 1 , iim
         xlon(i)     = xvrai(i)
Index: LMDZ5/branches/testing/libf/dyn3dmem/fxy.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fxy.F	(revision 1910)
+++ 	(revision )
@@ -1,69 +1,0 @@
-!
-! $Id: fxy.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
-     ,                    rlatu2,yprimu2,
-     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-      IMPLICIT NONE
-
-c     Auteur  :  P. Le Van
-c
-c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
-c           a tangente sinusoidale et eventuellement avec zoom  .
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "serre.h"
-#include "comconst.h"
-
-       INTEGER i,j
-
-       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
-     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
-
-#include "fxy_new.h"
-
-
-c    ......  calcul  des  latitudes  et de y'   .....
-c
-       DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( REAL( j )        )
-         yprimu(j) = fyprim( REAL( j )        )
-       ENDDO
-
-
-       DO j = 1, jjm
-
-         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
-         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
-
-        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
-        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
-
-       ENDDO
-
-c
-c     .....  calcul   des  longitudes et de  x'   .....
-c
-       DO i = 1, iim + 1
-           rlonv(i)     = fx    (   REAL( i )          )
-           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
-        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
-        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
-
-         xprimv  (i)    = fxprim (  REAL( i )          )
-         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
-       ENDDO
-
-c
-       RETURN
-       END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/fxyhyper.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fxyhyper.F	(revision 1910)
+++ 	(revision )
@@ -1,139 +1,0 @@
-!
-! $Header$
-!
-c
-c
-       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
-     ,                       xzoom, grossx, dzoomx,taux  ,
-     , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  , 
-     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-       IMPLICIT NONE
-c
-c      Auteur :  P. Le Van .
-c
-c      d'apres  formulations de R. Sadourny .
-c
-c
-c     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )
-c            par des  fonctions  a tangente hyperbolique .
-c
-c     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom
-c                      et  yzoom )   :  
-c
-c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
-c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
-c     c) la raideur de la transition du zoom  :   taux et tauy   
-c
-c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
-c ******
-c                  et              grossy * dzoomy <  pi/2  ( radians )
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-
-c   .....  Arguments  ...
-c
-       REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy
-       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
-     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
-       REAL(KIND=8)  dxmin, dxmax , dymin, dymax
-
-c   ....   var. locales   .....
-c
-       INTEGER i,j
-c
-
-       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  , 
-     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  dymin,dymax                                               )
-
-       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
-     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
-
-
-        DO i = 1, iip1
-          IF(rlonp025(i).LT.rlonv(i))  THEN
-           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
-            STOP
-          ENDIF
-
-          IF(rlonv(i).LT.rlonm025(i))  THEN 
-           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
-            STOP
-          ENDIF
-
-          IF(rlonp025(i).GT.rlonu(i))  THEN
-           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
-            STOP
-          ENDIF
-        ENDDO
-
-        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
-
-c
-       DO j = 1, jjm
-c
-       IF(rlatu1(j).LE.rlatu2(j))   THEN
-         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
-         STOP 13
-       ENDIF
-c
-       IF(rlatu2(j).LE.rlatu(j+1))  THEN
-        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
-        STOP 14
-       ENDIF
-c
-       IF(rlatu(j).LE.rlatu1(j))    THEN
-        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
-        STOP 15
-       ENDIF
-c
-       IF(rlatv(j).LE.rlatu2(j))    THEN
-        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
-        STOP 16
-       ENDIF
-c
-       IF(rlatv(j).ge.rlatu1(j))    THEN
-        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
-        STOP 17
-       ENDIF
-c
-       IF(rlatv(j).ge.rlatu(j))     THEN
-        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
-        STOP 18
-       ENDIF
-c
-       ENDDO
-c
-       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
-c
-        WRITE(6,18)
-        WRITE(6,*) '  Latitudes  '
-        WRITE(6,*) ' *********** '
-        WRITE(6,18)
-        WRITE(6,3)  dymin, dymax
-        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
-     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
-c
-        WRITE(6,18)
-        WRITE(6,*) '  Longitudes  '
-        WRITE(6,*) ' ************ '
-        WRITE(6,18)
-        WRITE(6,3)  dxmin, dxmax
-        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
-     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
-        WRITE(6,18)
-c
-3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
-     ,  ' d environ ',f8.2 ,' degres  ',
-     , ' alors que la maille en dehors de la zone du zoom est d environ
-     , ', f8.2,' degres ' )
-18      FORMAT(/)
-
-       RETURN
-       END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/fxysinus.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fxysinus.F	(revision 1910)
+++ 	(revision )
@@ -1,69 +1,0 @@
-!
-! $Id: fxysinus.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
-     ,                    rlatu2,yprimu2,
-     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-
-      IMPLICIT NONE
-c
-c     Calcul  des longitudes et des latitudes  pour une fonction f(x,y)
-c            avec y = Asin( j )  .
-c
-c     Auteur  :  P. Le Van
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-
-       INTEGER i,j
-
-       REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
-     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
-
-#include "fxy_sin.h"
-
-
-c    ......  calcul  des  latitudes  et de y'   .....
-c
-       DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( REAL( j )        )
-         yprimu(j) = fyprim( REAL( j )        )
-       ENDDO
-
-
-       DO j = 1, jjm
-
-         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
-         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
-
-        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
-        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
-
-       ENDDO
-
-c
-c     .....  calcul   des  longitudes et de  x'   .....
-c
-       DO i = 1, iim + 1
-           rlonv(i)     = fx    (   REAL( i )          )
-           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
-        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
-        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
-
-         xprimv  (i)    = fxprim (  REAL( i )          )
-         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
-       ENDDO
-
-c
-       RETURN
-       END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/fyhyp.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/fyhyp.F	(revision 1910)
+++ 	(revision )
@@ -1,378 +1,0 @@
-!
-! $Id: fyhyp.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzooma,tau  ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
-     ,  champmin,champmax                                            ) 
-
-cc    ...  Version du 01/04/2001 ....
-
-       IMPLICIT NONE
-c
-c    ...   Auteur :  P. Le Van  ... 
-c
-c    .......    d'apres  formulations  de R. Sadourny  .......
-c
-c     Calcule les latitudes et derivees dans la grille du GCM pour une
-c     fonction f(y) a tangente  hyperbolique  .
-c
-c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
-c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
-c
-c
-c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
-c      ********************************************************************
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-
-       INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
-c
-c
-c     .......  arguments  d'entree    .......
-c
-       REAL yzoomdeg, grossism,dzooma,tau 
-c         ( rentres  par  run.def )
-
-c     .......  arguments  de sortie   .......
-c
-       REAL rrlatu(jjp1), yyprimu(jjp1),rrlatv(jjm), yyprimv(jjm),
-     , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
-
-c
-c     .....     champs  locaux    .....
-c
-     
-       REAL   dzoom
-       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
-       REAL(KIND=8) yuv
-       REAL(KIND=8) yt(0:nmax2)
-       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
-       SAVE Ytprim, yt,Yf
-       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
-       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
-       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
-       REAL(KIND=8) yfi,Yf1,ffdy
-       REAL(KIND=8) ypn,deply,y00
-       SAVE y00, deply
-
-       INTEGER i,j,it,ik,iter,jlat
-       INTEGER jpn,jjpn
-       SAVE jpn
-       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
-       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
-       REAL y0min,y0max
-
-       REAL(KIND=8)     heavyside
-
-       pi       = 2. * ASIN(1.)
-       depi     = 2. * pi
-       pis2     = pi/2.
-       pisjm    = pi/ REAL(jjm)
-       epsilon  = 1.e-3
-       y0       =  yzoomdeg * pi/180. 
-
-       IF( dzooma.LT.1.)  THEN
-         dzoom = dzooma * pi
-       ELSEIF( dzooma.LT. 12. ) THEN
-         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
-     ,menter et relancer ! '
-         STOP 1
-       ELSE
-         dzoom = dzooma * pi/180.
-       ENDIF
-
-       WRITE(6,18)
-       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
-       WRITE(6,24) y0,grossism,tau,dzoom
-
-       DO i = 0, nmax2 
-        yt(i) = - pis2  + REAL(i)* pi /nmax2
-       ENDDO
-
-       heavyy0m = heavyside( -y0 )
-       heavyy0  = heavyside(  y0 )
-       y0min    = 2.*y0*heavyy0m - pis2
-       y0max    = 2.*y0*heavyy0  + pis2
-
-       fa = 999.999
-       fb = 999.999
-       
-       DO i = 0, nmax2 
-        IF( yt(i).LT.y0 )  THEN
-         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
-         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
-        ELSEIF ( yt(i).GT.y0 )  THEN
-         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
-         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
-       ENDIF
-        
-       IF( 200.* fb(i) .LT. - fa(i) )   THEN
-         fhyp ( i) = - 1.
-       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fhyp ( i) =   1.
-       ELSE  
-         fhyp(i) =  TANH ( fa(i)/fb(i) )
-       ENDIF
-
-       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
-       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
-
-       ENDDO
-
-cc  ....  Calcul  de  beta  ....
-c
-       ffdy   = 0.
-
-       DO i = 1, nmax2
-        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
-        IF( ymoy.LT.y0 )  THEN
-         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
-         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
-        ELSEIF ( ymoy.GT.y0 )  THEN
-         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
-         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
-        ENDIF
-
-        IF( 200.* fb(i) .LT. - fa(i) )    THEN
-         fxm ( i) = - 1.
-        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
-         fxm ( i) =   1.
-        ELSE
-         fxm(i) =  TANH ( fa(i)/fb(i) )
-        ENDIF
-         IF( ymoy.EQ.y0 )  fxm(i) = 1.
-         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
-         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
-
-        ENDDO
-
-        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
-
-       IF( 2.*beta - grossism.LE. 0.)  THEN
-
-        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
-     ,tine fyhyp est mauvaise ! '
-        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
-     , ' et relancer ! ***  '
-        CALL ABORT
-
-       ENDIF
-c
-c   .....  calcul  de  Ytprim   .....
-c
-       
-       DO i = 0, nmax2
-        Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
-       ENDDO
-
-c   .....  Calcul  de  Yf     ........
-
-       Yf(0) = - pis2
-       DO i = 1, nmax2
-        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
-       ENDDO
-
-       DO i=1,nmax2
-        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
-       ENDDO
-
-c    ****************************************************************
-c
-c   .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....
-c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
-c
-      WRITE(6,18)
-c
-      DO 5000  ik = 1,4
-
-       IF( ik.EQ.1 )  THEN
-         yuv  = 0.
-         jlat = jjm + 1
-       ELSE IF ( ik.EQ.2 )  THEN
-         yuv  = 0.5
-         jlat = jjm 
-       ELSE IF ( ik.EQ.3 )  THEN
-         yuv  = 0.25
-         jlat = jjm 
-       ELSE IF ( ik.EQ.4 )  THEN
-         yuv  = 0.75
-         jlat = jjm 
-       ENDIF
-c
-       yo1   = 0.
-       DO 1500 j =  1,jlat
-        yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
-        yfi    = ylon2
-c
-       DO 250 it =  nmax2,0,-1
-        IF( yfi.GE.Yf(it))  GO TO 350
-250    CONTINUE
-       it = 0
-350    CONTINUE
-
-       yi = yt(it)
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        Yf(it+1) = pis2
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
-c      .....           et   Y'(yi)                             .....
-c  .................................................................
-
-       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
-     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
-
-       Yf1     = Yf(it)
-       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
-
-       DO 500 iter = 1,300
-         yi = yi - ( Yf1 - yfi )/ Yprimin
-
-        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
-         yo1      = yi
-         yi2      = yi * yi
-         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
-         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
-500   CONTINUE
-        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
-         STOP 2
-550   CONTINUE
-c
-       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
-       yprim(j)  = pi / ( jjm * Yprimin )
-       yvrai(j)  = yi 
-
-1500    CONTINUE
-
-       DO j = 1, jlat -1
-        IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
-     ,  ')'
-         STOP 3
-        ENDIF
-       ENDDO
-
-       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
-     , ,' et  pi/2 '
-c
-        IF( ik.EQ.1 )   THEN
-           ypn = pis2 
-          DO j = jlat,1,-1
-           IF( yvrai(j).LE. ypn ) GO TO 1502
-          ENDDO
-1502     CONTINUE
-
-         jpn   = j
-         y00   = yvrai(jpn)
-         deply = pis2 -  y00
-        ENDIF
-
-         DO  j = 1, jjm +1 - jpn
-           ylatt (j)  = -pis2 - y00  + yvrai(jpn+j-1)
-           yprimm(j)  = yprim(jpn+j-1)
-         ENDDO
-
-         jjpn  = jpn
-         IF( jlat.EQ. jjm ) jjpn = jpn -1
-
-         DO j = 1,jjpn 
-          ylatt (j + jjm+1 -jpn) = yvrai(j) + deply
-          yprimm(j + jjm+1 -jpn) = yprim(j)
-         ENDDO
-
-c      ***********   Fin de la reorganisation     *************
-c
- 1600   CONTINUE
-
-       DO j = 1, jlat
-          ylat(j) =  ylatt( jlat +1 -j )
-         yprim(j) = yprimm( jlat +1 -j )
-       ENDDO
-  
-        DO j = 1, jlat
-         yvrai(j) = ylat(j)*180./pi
-        ENDDO
-
-        IF( ik.EQ.1 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatu(j) =  ylat( j )
-           yyprimu(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 2 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*)' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rrlatv(j) =  ylat( j )
-           yyprimv(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 3 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
-c         WRITE(6,68) (yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,445) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu2(j) =  ylat( j )
-           yprimu2(j) = yprim( j )
-          ENDDO
-
-        ELSE IF ( ik.EQ. 4 )  THEN
-c         WRITE(6,18) 
-c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
-c         WRITE(6,68)(yvrai(j),j=1,jlat)
-cc         WRITE(6,*) ' YPRIM '
-cc         WRITE(6,68) ( yprim(j),j=1,jlat)
-
-          DO j = 1, jlat
-            rlatu1(j) =  ylat( j )
-           yprimu1(j) = yprim( j )
-          ENDDO
-
-        ENDIF
-
-5000   CONTINUE
-c
-        WRITE(6,18)
-c
-c  .....     fin de la boucle  do 5000 .....
-
-        DO j = 1, jjm
-         ylat(j) = rrlatu(j) - rrlatu(j+1)
-        ENDDO
-        champmin =  1.e12
-        champmax = -1.e12
-        DO j = 1, jjm
-         champmin = MIN( champmin, ylat(j) )
-         champmax = MAX( champmax, ylat(j) )
-        ENDDO
-         champmin = champmin * 180./pi
-         champmax = champmax * 180./pi
-
-24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
-18      FORMAT(/)
-68      FORMAT(1x,7f9.2)
-
-        RETURN
-        END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gcm.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gcm.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/gcm.F	(revision 1999)
@@ -548,7 +548,7 @@
 c$OMP END PARALLEL
 
-      OPEN(unit=5487,file='ok_lmdz',status='replace')
-      WRITE(5487,*) 'ok_lmdz'
-      CLOSE(5487)
+!      OPEN(unit=5487,file='ok_lmdz',status='replace')
+!      WRITE(5487,*) 'ok_lmdz'
+!      CLOSE(5487)
       END
 
Index: LMDZ5/branches/testing/libf/dyn3dmem/geopot.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/geopot.F	(revision 1910)
+++ 	(revision )
@@ -1,64 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE geopot (ngrid, teta, pk, pks, phis, phi )
-      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
-
-
-c-----------------------------------------------------------------------
-c     calcul de phi au niveau 1 pres du sol  .....
-
-      DO   1  ij  = 1, ngrid
-      phi( ij,1 ) = phis( ij ) + teta(ij,1) * ( pks(ij) - pk(ij,1) )
-   1  CONTINUE
-
-c     calcul de phi aux niveaux superieurs  .......
-
-      DO  l = 2,llm
-        DO  ij    = 1,ngrid
-        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/branches/testing/libf/dyn3dmem/gr_dyn_fi.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_dyn_fi.F	(revision 1910)
+++ 	(revision )
@@ -1,38 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim'
-c   traitement des poles
-      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
-      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
-
-c   traitement des point normaux
-      DO ifield=1,nfield
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gr_ecrit_fi.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_ecrit_fi.F	(revision 1910)
+++ 	(revision )
@@ -1,32 +1,0 @@
-!
-! $Header$
-!
-	SUBROUTINE gr_ecrit_fi(nfield,nlon,iim,jjmp1,ecrit,fi)
-
-	IMPLICIT none
-
-c Transformer une variable de la grille d'ecriture a la grille physique
-	
-	INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim,jjmp1,nfield)
-c
-      INTEGER i, j, n, ig
-c
-c	print*,'iim jjm ',iim,jjm
-
-c modif par abd 21 02 01
-
-        jjm = jjmp1 - 1
-	do n = 1, nfield
-	    fi(1,n) = ecrit(1,1,n)
-            fi(nlon,n) = ecrit(1,jjm+1,n)
-         DO j = 2, jjm
-            ig = 2+(j-2)*iim
-            DO i = 1, iim
-	     fi(ig-1+i,n) = ecrit(i,j,n)
-            ENDDO
-         ENDDO
-      ENDDO
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/gr_fi_dyn.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_fi_dyn.F	(revision 1910)
+++ 	(revision )
@@ -1,40 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
-      IMPLICIT NONE
-c=======================================================================
-c   passage d'un champ de la grille scalaire a la grille physique
-c=======================================================================
-
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER im,jm,ngrid,nfield
-      REAL pdyn(im,jm,nfield)
-      REAL pfi(ngrid,nfield)
-
-      INTEGER i,j,ifield,ig
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      DO ifield=1,nfield
-c   traitement des poles
-         DO i=1,im
-            pdyn(i,1,ifield)=pfi(1,ifield)
-            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
-         ENDDO
-
-c   traitement des point normaux
-         DO j=2,jm-1
-	    ig=2+(j-2)*(im-1)
-            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
-	    pdyn(im,j,ifield)=pdyn(1,j,ifield)
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gr_int_dyn.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_int_dyn.F	(revision 1910)
+++ 	(revision )
@@ -1,49 +1,0 @@
-!
-! $Header$
-!
-      subroutine gr_int_dyn(champin,champdyn,iim,jp1)
-      implicit none
-c=======================================================================
-c   passage d'un champ interpole a un champ sur grille scalaire
-c=======================================================================
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      INTEGER iim
-      integer ip1, jp1
-      REAL champin(iim, jp1)
-      REAL champdyn(iim+1, jp1)
-
-      INTEGER i, j
-      real polenord, polesud
-
-c-----------------------------------------------------------------------
-c   calcul:
-c   -------
-
-      ip1 = iim + 1
-      polenord = 0.
-      polesud = 0.
-      do i = 1, iim
-        polenord = polenord + champin (i, 1)
-        polesud = polesud + champin (i, jp1)
-      enddo
-      polenord = polenord / iim
-      polesud = polesud / iim
-      do j = 1, jp1
-        do i = 1, iim
-          if (j .eq. 1) then
-            champdyn(i, j) = polenord
-          else if (j .eq. jp1) then
-            champdyn(i, j) = polesud
-          else
-            champdyn(i, j) = champin (i, j)
-          endif
-        enddo
-        champdyn(ip1, j) = champdyn(1, j)
-      enddo
-
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/gr_u_scal.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_u_scal.F	(revision 1910)
+++ 	(revision )
@@ -1,60 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_u_scal(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=======================================================================
-      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
-
-c-----------------------------------------------------------------------
-
-      DO l=1,nx
-         DO ij=ip1jmp1,2,-1
-            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
-
-      CALL SCOPY(nx*jjp1,x_scal(iip1,1),iip1,x_scal(1,1),iip1)
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gr_v_scal.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gr_v_scal.F	(revision 1910)
+++ 	(revision )
@@ -1,64 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gr_v_scal(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=======================================================================
-      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
-
-c-----------------------------------------------------------------------
-
-      DO l=1,nx
-         DO ij=iip2,ip1jm
-            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
-         DO ij=1,iip1
-            x_scal(ij,l)=0.
-         ENDDO
-         DO ij=ip1jm+1,ip1jmp1
-            x_scal(ij,l)=0.
-         ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/grad.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/grad.F	(revision 1910)
+++ 	(revision )
@@ -1,44 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE  grad(klevel, pg,pgx,pgy )
-c
-c      P. Le Van
-c
-c    ******************************************************************
-c     .. calcul des composantes covariantes en x et y du gradient de g
-c
-c    ******************************************************************
-c             pg        est un   argument  d'entree pour le s-prog
-c       pgx  et  pgy    sont des arguments de sortie pour le s-prog
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-      INTEGER klevel
-      REAL  pg( ip1jmp1,klevel )
-      REAL pgx( ip1jmp1,klevel ) , pgy( ip1jm,klevel )
-      INTEGER  l,ij
-c
-c
-      DO 6 l = 1,klevel
-c
-      DO 2  ij = 1, ip1jmp1 - 1
-      pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
-   2  CONTINUE
-c
-c    .... correction pour  pgx(ip1,j,l)  ....
-c    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
-CDIR$ IVDEP
-      DO 3  ij = iip1, ip1jmp1, iip1
-      pgx( ij,l ) = pgx( ij -iim,l )
-   3  CONTINUE
-c
-      DO 4 ij = 1,ip1jm
-      pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
-   4  CONTINUE
-c
-   6  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gradiv.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gradiv.F	(revision 1910)
+++ 	(revision )
@@ -1,57 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy )
-c
-c    Auteur :   P. Le Van
-c
-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    xcov , ycov 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
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
-#include "logic.h"
-
-      INTEGER klevel
-c
-      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
-      REAL gdx( ip1jmp1,klevel ),   gdy( ip1jm,klevel )
-
-      REAL div(ip1jmp1,llm)
-
-      INTEGER l,ij,iter,ld
-c
-c
-c
-      CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
-      CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
-c
-      DO 10 iter = 1,ld
-c
-      CALL  diverg( klevel,  gdx , gdy, div          )
-      CALL filtreg( div, jjp1, klevel, 2,1, .true.,2 )
-      CALL    grad( klevel,  div, gdx, gdy           )
-c
-      DO 5  l = 1, klevel
-      DO 3 ij = 1, ip1jmp1
-      gdx( ij,l ) = - gdx( ij,l ) * cdivu
-   3  CONTINUE
-      DO 4 ij = 1, ip1jm
-      gdy( ij,l ) = - gdy( ij,l ) * cdivu
-   4  CONTINUE
-   5  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gradiv2.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gradiv2.F	(revision 1910)
+++ 	(revision )
@@ -1,79 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
-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
-      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   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
-c
-c     ........       variables locales       .........
-c
-      REAL div(ip1jmp1,llm)
-      REAL signe, nugrads
-      INTEGER l,ij,iter,ld
-      
-c    ........................................................
-c
-c
-      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
-      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
-c
-c
-      signe   = (-1.)**ld
-      nugrads = signe * cdivu
-c
-
-
-      CALL    divergf( klevel, gdx,   gdy , div )
-
-      IF( ld.GT.1 )   THEN
-
-        CALL laplacien ( klevel, div,  div     )
-
-c    ......  Iteration de l'operateur laplacien_gam   .......
-
-        DO iter = 1, ld -2
-         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
-     *                       unsapolnga1, unsapolsga1,  div, div       )
-        ENDDO
-
-      ENDIF
-
-
-       CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
-       CALL  grad  ( klevel,  div,   gdx,  gdy             )
-
-c
-       DO   l = 1, klevel
-         DO  ij = 1, ip1jmp1
-          gdx( ij,l ) = gdx( ij,l ) * nugrads
-         ENDDO
-         DO  ij = 1, ip1jm
-          gdy( ij,l ) = gdy( ij,l ) * nugrads
-         ENDDO
-       ENDDO
-c
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/gradsdef.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/gradsdef.h	(revision 1910)
+++ 	(revision )
@@ -1,23 +1,0 @@
-!
-! $Header$
-!
-      integer nfmx,imx,jmx,lmx,nvarmx
-      parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000)
-
-      real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
-
-      integer imd(imx),jmd(jmx),lmd(lmx)
-      integer iid(imx),jid(jmx)
-      integer ifd(imx),jfd(jmx)
-      integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
-
-      integer nvar(nfmx),ivar(nfmx)
-      logical firsttime(nfmx)
-
-      character*10 var(nvarmx,nfmx),fichier(nfmx)
-      character*40 title(nfmx),tvar(nvarmx,nfmx)
-
-      common/gradsdef/xd,yd,zd,dtime,
-     s   imd,jmd,lmd,iid,jid,ifd,jfd,
-     s   unit,irec,nvar,ivar,itime,nld,firsttime,
-     s   var,fichier,title,tvar
Index: LMDZ5/branches/testing/libf/dyn3dmem/grid_atob.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/grid_atob.F	(revision 1910)
+++ 	(revision )
@@ -1,971 +1,0 @@
-!
-! $Id: grid_atob.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Aucune ponderation est consideree (voir grille_p)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-      REAL distans(2200*1100)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-c Calculer les limites des zones des nouveaux points
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c Determiner la zone sur laquelle chaque ancien point se trouve
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               number(ii,jj) = number(ii,jj) + 1.0
-               sortie(ii,jj) = sortie(ii,jj) + entree(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c Si aucun ancien point tombe sur une zone, c'est un probleme
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-      SUBROUTINE grille_p(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie)
-c=======================================================================
-c z.x.li (le 1 avril 1994) (voir aussi A. Harzallah et L. Fairhead)
-c
-c Methode naive pour transformer un champ d'une grille fine a une
-c grille grossiere. Je considere que les nouveaux points occupent
-c une zone adjacente qui comprend un ou plusieurs anciens points
-c
-c Consideration de la distance des points (voir grille_m)
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X et Y pour depart
-c        xdata, ydata: coordonnees X et Y pour depart
-c        entree: champ d'entree a transformer
-c OUTPUT:
-c        imar, jmar: dimensions X et Y d'arrivee
-c        x, y: coordonnees X et Y d'arrivee
-c        sortie: champ de sortie deja transforme
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(200),d(200)
-      REAL number(400,200)
-      INTEGER indx(400,200), indy(400,200)
-      REAL dist(400,200), distsom(400,200)
-c
-      IF (imar.GT.400 .OR. jmar.GT.200) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-      IF (imdep.GT.400 .OR. jmdep.GT.200) THEN
-         PRINT*, 'imdep ou jmdep trop grand', imdep, jmdep
-         CALL ABORT
-      ENDIF
-c
-c calculer les bords a et b de la nouvelle grille
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-c
-c calculer les bords c et d de la nouvelle grille
-c
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-c
-c trouver les indices (indx,indy) de la nouvelle grille sur laquelle
-c un point de l'ancienne grille est tombe.
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               indx(i,j) = ii
-               indy(i,j) = jj
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c faire une verification
-c
-
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         IF (indx(i,j).GT.imar .OR. indy(i,j).GT.jmar) THEN
-            PRINT*, 'Probleme grave,i,j,indx,indy=',
-     .              i,j,indx(i,j),indy(i,j)
-            CALL abort
-         ENDIF
-      ENDDO
-      ENDDO
-
-c
-c calculer la distance des anciens points avec le nouveau point,
-c on prend ensuite une sorte d'inverse pour ponderation.
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         distsom(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = SQRT ( (xdata(i)-x(indx(i,j)))**2
-     .                     +(ydata(j)-y(indy(i,j)))**2 )
-         distsom(indx(i,j),indy(i,j)) = distsom(indx(i,j),indy(i,j))
-     .                                  + dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j)) +1.
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         dist(i,j) = 1.0 - dist(i,j)/distsom(indx(i,j),indy(i,j))
-      ENDDO
-      ENDDO
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         number(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-      DO i = 1, imdep
-      DO j = 1, jmdep
-         sortie(indx(i,j),indy(i,j)) = sortie(indx(i,j),indy(i,j))
-     .                                 + entree(i,j) * dist(i,j)
-         number(indx(i,j),indy(i,j)) = number(indx(i,j),indy(i,j))
-     .                                 + dist(i,j)
-      ENDDO
-      ENDDO
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (number(i,j) .GT. 0.001) THEN
-         sortie(i,j) = sortie(i,j) / number(i,j)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-      SUBROUTINE mask_c_o(imdep, jmdep, xdata, ydata, relief,
-     .                    imar, jmar, x, y, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): A partir du champ de relief, on fabrique
-c                           un champ indicateur (masque) terre/ocean
-c                           terre:1; ocean:0
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL relief(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL num_tot(2200,1100), num_oce(2200,1100)
-c
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_oce(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-               num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-               IF (.NOT. ( relief(i,j) - 0.9. GE. 1.e-5 ) )
-     .             num_oce(ii,jj) = num_oce(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-c
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF ( num_oce(i,j)/num_tot(i,j) - 0.5 .GE. 1.e-5 ) THEN
-              mask(i,j) = 0.
-           ELSE
-              mask(i,j) = 1.
-           ENDIF
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-c
-c
-
-
-      SUBROUTINE rugosite(imdep, jmdep, xdata, ydata, entree,
-     .                    imar, jmar, x, y, sortie, mask)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer la longueur de rugosite d'une
-c grille fine a une grille grossiere. Sur l'ocean, on impose une valeur
-c fixe (0.001m).
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL entree(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL sortie(imar,jmar), mask(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_tot(i,j) = 0.0
-         sortie(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              sortie(ii,jj)  = sortie(ii,jj) + LOG(entree(i,j))
-              num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-       IF (NINT(mask(i,j)).EQ.1) THEN
-         IF (num_tot(i,j) .GT. 0.0) THEN
-            sortie(i,j) = sortie(i,j) / num_tot(i,j)
-            sortie(i,j) = EXP(sortie(i,j))
-         ELSE
-            PRINT*, 'probleme,i,j=', i,j
-ccc            CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         sortie(i,j) = entree(i_proche,j_proche)
-         ENDIF
-       ELSE
-         sortie(i,j) = 0.001
-       ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-
-
-      SUBROUTINE sea_ice(imdep, jmdep, xdata, ydata, glace01,
-     .                    imar, jmar, x, y, frac_ice)
-c=======================================================================
-c z.x.li (le 1 avril 1994): Transformer un champ d'indicateur de la
-c glace (1, sinon 0) d'une grille fine a un champ de fraction de glace
-c (entre 0 et 1) dans une grille plus grossiere.
-c
-c Methode naive (voir grille_m)
-C=======================================================================
-      IMPLICIT none
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL glace01(imdep,jmdep)
-c
-      INTEGER imar, jmar
-      REAL x(imar),y(jmar)
-      REAL frac_ice(imar,jmar)
-c
-      INTEGER i, j, ii, jj
-      REAL a(400),b(400),c(400),d(400)
-      REAL num_tot(400,400), num_ice(400,400)
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      IF (imar.GT.400 .OR. jmar.GT.400) THEN
-         PRINT*, 'imar ou jmar trop grand', imar, jmar
-         CALL ABORT
-      ENDIF
-c
-
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar-1
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar) = b(imar-1)
-      b(imar) = x(imar) + (x(imar)-x(imar-1))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         num_ice(i,j) = 0.0
-         num_tot(i,j) = 0.0
-      ENDDO
-      ENDDO
-
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imar
-      DO jj = 1, jmar
-        DO i = 1, imdep
-         IF( ( xdata(i)-a(ii).GE.1.e-5.AND.xdata(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xdata(i)-a(ii).LE.1.e-5.AND.xdata(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmdep
-          IF( (ydata(j)-c(jj).GE.1.e-5.AND.ydata(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ydata(j)-c(jj).LE.1.e-5.AND.ydata(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-             num_tot(ii,jj) = num_tot(ii,jj) + 1.0
-              IF (NINT(glace01(i,j)).EQ.1 ) 
-     .       num_ice(ii,jj) = num_ice(ii,jj) + 1.0
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-
-      DO i = 1, imar
-      DO j = 1, jmar
-         IF (num_tot(i,j) .GT. 0.001) THEN
-           IF (num_ice(i,j).GT.0.001) THEN
-            frac_ice(i,j) = num_ice(i,j) / num_tot(i,j)
-           ELSE
-              frac_ice(i,j) = 0.0
-           ENDIF
-         ELSE
-           PRINT*, 'probleme,i,j=', i,j
-ccc           CALL ABORT
-         CALL dist_sphe(x(i),y(j),xdata,ydata,imdep,jmdep,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imdep*jmdep,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imdep*jmdep
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imdep + 1
-         i_proche = ij_proche - (j_proche-1)*imdep
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         IF (NINT(glace01(i_proche,j_proche)).EQ.1 ) THEN
-            frac_ice(i,j) = 1.0
-         ELSE
-            frac_ice(i,j) = 0.0
-         ENDIF
-         ENDIF
-      ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
-      SUBROUTINE rugsoro(imrel, jmrel, xrel, yrel, relief,
-     .                    immod, jmmod, xmod, ymod, rugs)
-c=======================================================================
-c Calculer la longueur de rugosite liee au relief en utilisant
-c l'ecart-type dans une maille de 1x1
-C=======================================================================
-      IMPLICIT none
-c
-#ifdef CRAY
-      INTEGER ISMIN
-#else
-      REAL zzmin
-#endif
-c
-      REAL amin, AMAX
-c
-      INTEGER imrel, jmrel
-      REAL xrel(imrel),yrel(jmrel)
-      REAL relief(imrel,jmrel)
-c
-      INTEGER immod, jmmod
-      REAL xmod(immod),ymod(jmmod)
-      REAL rugs(immod,jmmod)
-c
-      INTEGER imtmp, jmtmp
-      PARAMETER (imtmp=360,jmtmp=180)
-      REAL xtmp(imtmp), ytmp(jmtmp)
-      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
-      REAL zzzz
-c
-      INTEGER i, j, ii, jj
-      REAL a(2200),b(2200),c(1100),d(1100)
-      REAL number(2200,1100)
-c
-      REAL distans(400*400)
-      INTEGER i_proche, j_proche, ij_proche
-c
-      IF (immod.GT.2200 .OR. jmmod.GT.1100) THEN
-         PRINT*, 'immod ou jmmod trop grand', immod, jmmod
-         CALL ABORT
-      ENDIF
-c
-c Calculs intermediares:
-c
-      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
-      DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
-      ENDDO
-      DO i = 1, imtmp
-         xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
-      DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
-      ENDDO
-      DO j = 1, jmtmp
-         ytmp(j) = ytmp(j) /180.0 * 4.0*ATAN(1.0)
-      ENDDO
-c
-      a(1) = xtmp(1) - (xtmp(2)-xtmp(1))/2.0
-      b(1) = (xtmp(1)+xtmp(2))/2.0
-      DO i = 2, imtmp-1
-         a(i) = b(i-1)
-         b(i) = (xtmp(i)+xtmp(i+1))/2.0
-      ENDDO
-      a(imtmp) = b(imtmp-1)
-      b(imtmp) = xtmp(imtmp) + (xtmp(imtmp)-xtmp(imtmp-1))/2.0
-
-      c(1) = ytmp(1) - (ytmp(2)-ytmp(1))/2.0
-      d(1) = (ytmp(1)+ytmp(2))/2.0
-      DO j = 2, jmtmp-1
-         c(j) = d(j-1)
-         d(j) = (ytmp(j)+ytmp(j+1))/2.0
-      ENDDO
-      c(jmtmp) = d(jmtmp-1)
-      d(jmtmp) = ytmp(jmtmp) + (ytmp(jmtmp)-ytmp(jmtmp-1))/2.0
-
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         number(i,j) = 0.0
-         cham1tmp(i,j) = 0.0
-         cham2tmp(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, imtmp
-      DO jj = 1, jmtmp
-        DO i = 1, imrel
-         IF( ( xrel(i)-a(ii).GE.1.e-5.AND.xrel(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xrel(i)-a(ii).LE.1.e-5.AND.xrel(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmrel
-          IF( (yrel(j)-c(jj).GE.1.e-5.AND.yrel(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  yrel(j)-c(jj).LE.1.e-5.AND.yrel(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              cham1tmp(ii,jj) = cham1tmp(ii,jj) + relief(i,j)
-              cham2tmp(ii,jj) = cham2tmp(ii,jj) 
-     .                              + relief(i,j)*relief(i,j)
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, imtmp
-      DO j = 1, jmtmp
-         IF (number(i,j) .GT. 0.001) THEN
-         cham1tmp(i,j) = cham1tmp(i,j) / number(i,j)
-         cham2tmp(i,j) = cham2tmp(i,j) / number(i,j)
-         zzzz=cham2tmp(i,j)-cham1tmp(i,j)**2
-         if (zzzz .lt. 0.0) then
-           if (zzzz .gt. -7.5) then
-             zzzz = 0.0
-             print*,'Pb rugsoro, -7.5 < zzzz < 0, => zzz = 0.0'
-           else
-              stop 'Pb rugsoro, zzzz <-7.5'
-           endif
-         endif
-         cham2tmp(i,j) = SQRT(zzzz)
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-         CALL ABORT
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = cham2tmp(1,1)
-      AMAX = cham2tmp(1,1)
-      DO j = 1, jmtmp
-      DO i = 1, imtmp
-         IF (cham2tmp(i,j).GT.AMAX) AMAX = cham2tmp(i,j)
-         IF (cham2tmp(i,j).LT.amin) amin = cham2tmp(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type 1x1:', amin, AMAX
-c
-c
-c
-      a(1) = xmod(1) - (xmod(2)-xmod(1))/2.0
-      b(1) = (xmod(1)+xmod(2))/2.0
-      DO i = 2, immod-1
-         a(i) = b(i-1)
-         b(i) = (xmod(i)+xmod(i+1))/2.0
-      ENDDO
-      a(immod) = b(immod-1)
-      b(immod) = xmod(immod) + (xmod(immod)-xmod(immod-1))/2.0
-
-      c(1) = ymod(1) - (ymod(2)-ymod(1))/2.0
-      d(1) = (ymod(1)+ymod(2))/2.0
-      DO j = 2, jmmod-1
-         c(j) = d(j-1)
-         d(j) = (ymod(j)+ymod(j+1))/2.0
-      ENDDO
-      c(jmmod) = d(jmmod-1)
-      d(jmmod) = ymod(jmmod) + (ymod(jmmod)-ymod(jmmod-1))/2.0
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         number(i,j) = 0.0
-         rugs(i,j) = 0.0
-      ENDDO
-      ENDDO
-c
-c
-c
-c  .....  Modif  P. Le Van ( 23/08/95 )  ....
-
-      DO ii = 1, immod
-      DO jj = 1, jmmod
-        DO i = 1, imtmp
-         IF( ( xtmp(i)-a(ii).GE.1.e-5.AND.xtmp(i)-b(ii).LE.1.e-5 ).OR.
-     .     (   xtmp(i)-a(ii).LE.1.e-5.AND.xtmp(i)-b(ii).GE.1.e-5 )   )
-     .           THEN
-          DO j = 1, jmtmp
-          IF( (ytmp(j)-c(jj).GE.1.e-5.AND.ytmp(j)-d(jj).LE.1.e-5 ).OR.
-     .      (  ytmp(j)-c(jj).LE.1.e-5.AND.ytmp(j)-d(jj).GE.1.e-5 )   )
-     .           THEN
-              number(ii,jj) = number(ii,jj) + 1.0
-              rugs(ii,jj) = rugs(ii,jj)
-     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
-          ENDIF
-          ENDDO
-         ENDIF
-        ENDDO
-      ENDDO
-      ENDDO
-c
-c
-      DO i = 1, immod
-      DO j = 1, jmmod
-         IF (number(i,j) .GT. 0.001) THEN
-         rugs(i,j) = rugs(i,j) / number(i,j)
-         rugs(i,j) = EXP(rugs(i,j))
-         ELSE
-         PRINT*, 'probleme,i,j=', i,j
-ccc         CALL ABORT
-         CALL dist_sphe(xmod(i),ymod(j),xtmp,ytmp,imtmp,jmtmp,distans)
-#ifdef CRAY
-         ij_proche = ISMIN(imtmp*jmtmp,distans,1)
-#else
-         ij_proche = 1
-         zzmin = distans(ij_proche)
-         DO ii = 2, imtmp*jmtmp
-            IF (distans(ii).LT.zzmin) THEN
-               zzmin = distans(ii)
-               ij_proche = ii
-            ENDIF
-         ENDDO
-#endif
-         j_proche = (ij_proche-1)/imtmp + 1
-         i_proche = ij_proche - (j_proche-1)*imtmp
-         PRINT*, "solution:", ij_proche, i_proche, j_proche
-         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
-         ENDIF
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Ecart-type du modele:', amin, AMAX
-c
-      DO j = 1, jmmod
-      DO i = 1, immod
-         rugs(i,j) = rugs(i,j) / AMAX * 20.0
-      ENDDO
-      ENDDO
-c
-      amin = rugs(1,1)
-      AMAX = rugs(1,1)
-      DO j = 1, jmmod
-      DO i = 1, immod
-         IF (rugs(i,j).GT.AMAX) AMAX = rugs(i,j)
-         IF (rugs(i,j).LT.amin) amin = rugs(i,j)
-      ENDDO
-      ENDDO
-      PRINT*, 'Longueur de rugosite du modele:', amin, AMAX
-c
-      RETURN
-      END
-c
-      SUBROUTINE dist_sphe(rf_lon,rf_lat,rlon,rlat,im,jm,distance)
-c
-c Auteur: Laurent Li (le 30 decembre 1996)
-c
-c Ce programme calcule la distance minimale (selon le grand cercle)
-c entre deux points sur la terre
-c
-c Input:
-      INTEGER im, jm ! dimensions
-      REAL rf_lon ! longitude du point de reference (degres)
-      REAL rf_lat ! latitude du point de reference (degres)
-      REAL rlon(im), rlat(jm) ! longitude et latitude des points
-c
-c Output:
-      REAL distance(im,jm) ! distances en metre
-c
-      REAL rlon1, rlat1
-      REAL rlon2, rlat2
-      REAL dist
-      REAL pa, pb, p, pi
-c
-      REAL radius
-      PARAMETER (radius=6371229.)
-c
-      pi = 4.0 * ATAN(1.0)
-c
-      DO 9999 j = 1, jm
-      DO 9999 i = 1, im
-c
-      rlon1=rf_lon
-      rlat1=rf_lat
-      rlon2=rlon(i)
-      rlat2=rlat(j)
-      pa = pi/2.0 - rlat1*pi/180.0 ! dist. entre pole n et point a
-      pb = pi/2.0 - rlat2*pi/180.0 ! dist. entre pole n et point b
-      p = (rlon1-rlon2)*pi/180.0 ! angle entre a et b (leurs meridiens)
-c
-      dist = ACOS( COS(pa)*COS(pb) + SIN(pa)*SIN(pb)*COS(p))
-      dist = radius * dist
-      distance(i,j) = dist
-c
- 9999 CONTINUE
-c
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/grid_noro.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/grid_noro.F	(revision 1910)
+++ 	(revision )
@@ -1,521 +1,0 @@
-!
-! $Id$
-!
-c
-c
-      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
-     .             imar, jmar, x, y,
-     .             zphi,zmea,zstd,zsig,zgam,zthe,
-     .             zpic,zval,mask)
-c=======================================================================
-c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
-c
-c      Compute the Parameters of the SSO scheme as described in
-c      LOTT & MILLER (1997) and LOTT(1999).
-c      Target points are on a rectangular grid:
-c      iim+1 latitudes including North and South Poles;
-c      jjm+1 longitudes, with periodicity jjm+1=1.
-c      aux poles.  At the poles the fields value is repeated
-c      jjm+1 time.
-c      The parameters a,b,c,d represent the limite of the target
-c      gridpoint region. The means over this region are calculated
-c      from USN data, ponderated by a weight proportional to the 
-c      surface occupated by the data inside the model gridpoint area.
-c      In most circumstances, this weight is the ratio between the
-c      surface of the USN gridpoint area and the surface of the
-c      model gridpoint area. 
-c
-c           (c)
-c        ----d-----
-c        | . . . .|
-c        |        |
-c     (b)a . * . .b(a)
-c        |        |
-c        | . . . .|
-c        ----c-----
-c           (d)
-C=======================================================================
-c INPUT:
-c        imdep, jmdep: dimensions X and Y input field
-c        xdata, ydata: coordinates X and Y input field
-c        zdata: Input field
-c        In this version it is assumed that the entry data come from
-c        the USNavy dataset: imdep=iusn=2160, jmdep=jusn=1080.
-c OUTPUT:
-c        imar, jmar: dimensions X and Y Output field
-c        x, y: ccordinates  X and Y Output field.
-c             zmea:  Mean orographie   
-c             zstd:  Standard deviation
-c             zsig:  Slope
-c             zgam:  Anisotropy
-c             zthe:  Orientation of the small axis
-c             zpic:  Maximum altitude
-c             zval:  Minimum altitude
-C=======================================================================
-
-      IMPLICIT INTEGER (I,J)
-      IMPLICIT REAL(X,Z) 
-      
-	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
-#include "dimensions.h"
-	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
-      REAL zusn(iusn+2*iext,jusn+2)
-
-      INTEGER imdep, jmdep
-      REAL xdata(imdep),ydata(jmdep) 
-      REAL zdata(imdep,jmdep)
-c
-      INTEGER imar, jmar
-  
-C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
-
-      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
-      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
-      REAL weight(iim+1,jjm+1)
-
-C CORRELATIONS OF USN OROGRAPHY GRADIENTS
-
-      REAL zxtzxusn(iusn+2*iext,jusn+2),zytzyusn(iusn+2*iext,jusn+2)
-      REAL zxtzyusn(iusn+2*iext,jusn+2)
-      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
-      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
-      REAL zmea0(imar+1,jmar) ! GK211005 (CG)
-      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
-      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
-cxxx PB     integer mask(imar+1,jmar)
-      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
-      real num_tot(2200,1100),num_lan(2200,1100)
-c
-      REAL a(2200),b(2200),c(1100),d(1100)
-      logical masque_lu
-c
-      print *,' parametres de l orographie a l echelle sous maille' 
-      xpi=acos(-1.)
-      rad    = 6 371 229.
-      zdeltay=2.*xpi/REAL(jusn)*rad
-c
-c utilise-t'on un masque lu?
-c
-      masque_lu = .true.
-      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
-        masque_lu= .false.
-        masque = 0.0
-      endif
-      write(*,*)'Masque lu', masque_lu
-c
-c  quelques tests de dimensions:
-c    
-c
-      if(iim.ne.imar) STOP 'Problem dim. x'
-      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
-      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
-         PRINT*, 'imar or jmar too big', imar, jmar
-         CALL ABORT
-      ENDIF
-
-      IF(imdep.ne.iusn.or.jmdep.ne.jusn)then
-         print *,' imdep or jmdep bad dimensions:',imdep,jmdep
-         call abort
-      ENDIF
-
-      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
-        print *,' imar or jmar bad dimensions:',imar,jmar
-        call abort
-      ENDIF
-
-
-c      print *,'xdata:',xdata
-c      print *,'ydata:',ydata
-c      print *,'x:',x
-c      print *,'y:',y
-c
-C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
-C  BOUNDARIES:
-c
-      DO j=1,jusn
-        yusn(j+1)=ydata(j)
-      DO i=1,iusn
-        zusn(i+iext,j+1)=zdata(i,j)
-        xusn(i+iext)=xdata(i)
-      ENDDO
-      DO i=1,iext
-        zusn(i,j+1)=zdata(iusn-iext+i,j)
-        xusn(i)=xdata(iusn-iext+i)-2.*xpi
-        zusn(iusn+iext+i,j+1)=zdata(i,j)
-        xusn(iusn+iext+i)=xdata(i)+2.*xpi
-      ENDDO
-      ENDDO
-
-        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
-        yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))
-       DO i=1,iusn/2+iext
-        zusn(i,1)=zusn(i+iusn/2,2)
-        zusn(i+iusn/2+iext,1)=zusn(i,2)
-        zusn(i,jusn+2)=zusn(i+iusn/2,jusn+1)
-        zusn(i+iusn/2+iext,jusn+2)=zusn(i,jusn+1)
-       ENDDO
-c  
-c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
-C     ( REGULAR GRID)
-c
-      a(1) = x(1) - (x(2)-x(1))/2.0
-      b(1) = (x(1)+x(2))/2.0
-      DO i = 2, imar
-         a(i) = b(i-1)
-         b(i) = (x(i)+x(i+1))/2.0
-      ENDDO
-      a(imar+1) = b(imar)
-      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
-
-      c(1) = y(1) - (y(2)-y(1))/2.0
-      d(1) = (y(1)+y(2))/2.0
-      DO j = 2, jmar-1
-         c(j) = d(j-1)
-         d(j) = (y(j)+y(j+1))/2.0
-      ENDDO
-      c(jmar) = d(jmar-1)
-      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
-c
-c  initialisations:
-c
-      DO i = 1, imar+1
-      DO j = 1, jmar
-         weight(i,j) = 0.0
-         zxtzx(i,j)  = 0.0
-         zytzy(i,j)  = 0.0
-         zxtzy(i,j)  = 0.0
-         ztz(i,j)    = 0.0
-         zmea(i,j)   = 0.0
-         zpic(i,j)  =-1.E+10
-         zval(i,j)  = 1.E+10
-      ENDDO
-      ENDDO
-c
-c  COMPUTE SLOPES CORRELATIONS ON USN GRID
-c
-         DO j = 1,jusn+2 
-         DO i = 1, iusn+2*iext
-            zytzyusn(i,j)=0.0
-            zxtzxusn(i,j)=0.0
-            zxtzyusn(i,j)=0.0
-         ENDDO
-         ENDDO
-
-
-         DO j = 2,jusn+1 
-            zdeltax=zdeltay*cos(yusn(j))
-         DO i = 2, iusn+2*iext-1
-            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
-            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
-            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
-     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
-         ENDDO
-         ENDDO
-c
-c  SUMMATION OVER GRIDPOINT AREA
-c 
-      zleny=xpi/REAL(jusn)*rad
-      xincr=xpi/2./REAL(jusn)
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-       num_tot(ii,jj)=0.
-       num_lan(ii,jj)=0.
-c        PRINT *,' iteration ii jj:',ii,jj
-         DO j = 2,jusn+1 
-c         DO j = 3,jusn 
-            zlenx=zleny*cos(yusn(j))
-            zdeltax=zdeltay*cos(yusn(j))
-            zbordnor=(c(jj)-yusn(j)+xincr)*rad
-            zbordsud=(yusn(j)-d(jj)+xincr)*rad
-            weighy=AMAX1(0.,
-     *             amin1(zbordnor,zbordsud,zleny))
-         IF(weighy.ne.0)THEN
-         DO i = 2, iusn+2*iext-1
-            zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))
-            zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))
-            weighx=AMAX1(0.,
-     *             amin1(zbordest,zbordoue,zlenx))
-            IF(weighx.ne.0)THEN
-            num_tot(ii,jj)=num_tot(ii,jj)+1.0
-            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
-            weight(ii,jj)=weight(ii,jj)+weighx*weighy
-            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
-            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
-            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
-            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
-c mean
-            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
-c peacks
-            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
-c valleys
-            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
-            ENDIF
-         ENDDO
-         ENDIF
-         ENDDO
-       ENDDO
-       ENDDO
-c
-c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
-C  LOTT (1999) SSO SCHEME.
-c
-      zllmmea=0.
-      zllmstd=0.
-      zllmsig=0.
-      zllmgam=0.
-      zllmpic=0.
-      zllmval=0.
-      zllmthe=0.
-      zminthe=0.
-c     print 100,' '
-c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
-       DO ii = 1, imar+1
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Mask
-cXXX           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
-cXXX             mask(ii,jj)=1
-cXXX           else
-cXXX             mask(ii,jj)=0
-cXXX           ENDIF
-             if (.not. masque_lu) then
-               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
-             endif
-c  Mean Orography:
-           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
-           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
-           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
-           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
-           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
-c  Standard deviation:
-           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
-         ELSE
-            PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-       ENDDO
-       ENDDO
-
-C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
-
-       DO ii = 1, imar+1
-         zxtzx(ii,1)=zxtzx(ii,2)
-         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
-         zxtzy(ii,1)=zxtzy(ii,2)
-         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
-         zytzy(ii,1)=zytzy(ii,2)
-         zytzy(ii,jmar)=zytzy(ii,jmar-1)
-       ENDDO
-
-C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
-
-C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
-
-       zmea0(:,:) = zmea(:,:) ! GK211005 (CG) on sauvegarde la topo non lissee
-       CALL MVA9(zmea,iim+1,jjm+1)
-       CALL MVA9(zstd,iim+1,jjm+1)
-       CALL MVA9(zpic,iim+1,jjm+1)
-       CALL MVA9(zval,iim+1,jjm+1)
-       CALL MVA9(zxtzx,iim+1,jjm+1)
-       CALL MVA9(zxtzy,iim+1,jjm+1) 
-       CALL MVA9(zytzy,iim+1,jjm+1)
-CXXX   Masque prenant en compte maximum de terre
-CXXX  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
-CXXX pas de sens (PB)
-       mask_tmp= 0.0
-       WHERE(mask .GE. 0.1) mask_tmp = 1.
-
-       DO ii = 1, imar
-       DO jj = 1, jmar
-         IF (weight(ii,jj) .NE. 0.0) THEN
-c  Coefficients K, L et M:
-           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
-           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
-           xm=zxtzy(ii,jj)
-           xp=xk-sqrt(xl**2+xm**2)
-           xq=xk+sqrt(xl**2+xm**2)
-           xw=1.e-8
-           if(xp.le.xw) xp=0.
-           if(xq.le.xw) xq=xw
-           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
-c slope: 
-cXXX           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
-cXXXc isotropy:
-cXXX           zgam(ii,jj)=xp/xq*mask(ii,jj)
-cXXXc angle theta:
-cXXX           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
-cXXX           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-cXXX           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
-cXXX           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
-cXXX           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
-CXX* PB modif pour maque de terre fractionnaire
-c slope: 
-           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
-c isotropy:
-           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
-c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
-           ! GK211005 (CG) ne pas forcement lisser la topo
-           ! zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zphi(ii,jj)=zmea0(ii,jj)*mask_tmp(ii,jj)
-           !
-           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
-           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
-           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
-           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
-c          print 101,ii,jj,
-c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
-c    *           zthe(ii,jj)
-c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
-         ELSE
-c           PRINT*, 'probleme,ii,jj=', ii,jj
-         ENDIF
-      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
-      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
-      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
-      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
-      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
-      zminthe=amin1(zthe(ii,jj),zminthe)
-      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
-      zllmval=AMAX1(zval(ii,jj),zllmval)
-       ENDDO
-       ENDDO
-      print *,'  MEAN ORO:',zllmmea
-      print *,'  ST. DEV.:',zllmstd
-      print *,'  PENTE:',zllmsig
-      print *,' ANISOTROP:',zllmgam
-      print *,'  ANGLE:',zminthe,zllmthe	
-      print *,'  pic:',zllmpic
-      print *,'  val:',zllmval
-      
-C
-c gamma and theta a 1. and 0. at poles
-c
-      DO jj=1,jmar
-      zmea(imar+1,jj)=zmea(1,jj)
-      zphi(imar+1,jj)=zphi(1,jj)
-      zpic(imar+1,jj)=zpic(1,jj)
-      zval(imar+1,jj)=zval(1,jj)
-      zstd(imar+1,jj)=zstd(1,jj)
-      zsig(imar+1,jj)=zsig(1,jj)
-      zgam(imar+1,jj)=zgam(1,jj)
-      zthe(imar+1,jj)=zthe(1,jj)
-      ENDDO
-
-
-      zmeanor=0.0
-      zmeasud=0.0
-      zstdnor=0.0
-      zstdsud=0.0
-      zsignor=0.0
-      zsigsud=0.0
-      zweinor=0.0
-      zweisud=0.0
-      zpicnor=0.0
-      zpicsud=0.0                                   
-      zvalnor=0.0
-      zvalsud=0.0 
-
-      DO ii=1,imar
-      zweinor=zweinor+              weight(ii,   1)
-      zweisud=zweisud+              weight(ii,jmar)
-      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
-      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
-      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
-      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
-      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
-      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
-      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
-      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
-      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
-      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
-      ENDDO
-
-      DO ii=1,imar+1
-      zmea(ii,   1)=zmeanor/zweinor
-      zmea(ii,jmar)=zmeasud/zweisud
-      zphi(ii,   1)=zmeanor/zweinor
-      zphi(ii,jmar)=zmeasud/zweisud
-      zpic(ii,   1)=zpicnor/zweinor
-      zpic(ii,jmar)=zpicsud/zweisud
-      zval(ii,   1)=zvalnor/zweinor
-      zval(ii,jmar)=zvalsud/zweisud
-      zstd(ii,   1)=zstdnor/zweinor
-      zstd(ii,jmar)=zstdsud/zweisud
-      zsig(ii,   1)=zsignor/zweinor
-      zsig(ii,jmar)=zsigsud/zweisud
-      zgam(ii,   1)=1.
-      zgam(ii,jmar)=1.
-      zthe(ii,   1)=0.
-      zthe(ii,jmar)=0.
-      ENDDO
-
-      RETURN
-      END
-
-      SUBROUTINE MVA9(X,IMAR,JMAR)
-
-C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
-
-      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
-      real WEIGHTpb(-1:1,-1:1)
-
-      
-      SUM=0.
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
-          SUM=SUM+WEIGHTpb(IS,JS)
-        ENDDO
-      ENDDO
-      
-c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
-c     WRITE(*,*) 'MVA9 ', WEIGHTpb
-c     WRITE(*,*) 'MVA9 SUM ', SUM
-      DO IS=-1,1
-        DO JS=-1,1
-          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        DO I=2,IMAR-1
-          XF(I,J)=0.
-          DO IS=-1,1
-            DO JS=-1,1
-              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
-            ENDDO
-          ENDDO
-        ENDDO
-      ENDDO
-
-      DO J=2,JMAR-1
-        XF(1,J)=0.
-        IS=IMAR-1
-        DO JS=-1,1 
-          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
-        ENDDO
-        DO IS=0,1 
-          DO JS=-1,1 
-            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
-          ENDDO
-        ENDDO
-        XF(IMAR,J)=XF(1,J)
-      ENDDO
-
-      DO I=1,IMAR
-        XF(I,1)=XF(I,2)
-        XF(I,JMAR)=XF(I,JMAR-1)
-      ENDDO
-
-      DO I=1,IMAR
-        DO J=1,JMAR
-          X(I,J)=XF(I,J)
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
-
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/grilles_gcm_netcdf.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/grilles_gcm_netcdf.F	(revision 1910)
+++ 	(revision )
@@ -1,305 +1,0 @@
-!
-! $Id: grilles_gcm_netcdf.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-
-      PROGRAM create_fausse_var
-C
-      IMPLICIT NONE
-C
-C
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "comvert.h"
-
-      real temp(iim+1,jjm+1)
-#include "netcdf.inc"
-
-c Attributs netcdf sortie
-        character*64 fich_out
-        integer*4 ncid_out,rcode_out
-        integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid
-        integer*4 out_varid
-        integer*4 out_lonudim,out_lonvdim
-        integer*4 out_latudim,out_latvdim,out_dim(3)
-
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-
-      integer start(4),count(4)
-
-	integer status,i,j
-        real rlatudeg(jjp1),rlatvdeg(jjm)
-        real rlonudeg(iip1),rlonvdeg(iip1)
-
-      real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
-      real acoslat,dxkm,dykm,resol(iip1,jjp1)
-
-#include "serre.h"
-#include "fxyprim.h"
-
-      print*,'OK0'
-
-      rad = 6400000
-      omeg = 7.272205e-05
-      g = 9.8
-      kappa = 0.285716
-      daysec = 86400
-      cpp = 1004.70885
-
-      preff = 101325.
-      pa= 50000.
-
-c     open(99,file='run.def',status='old',form='formatted')
-c     CALL defrun_new( 99, .TRUE.,clesphy0 )
-c     close(99)
-
-      CALL conf_gcm( 99, .TRUE. , clesphy0 )
-      CALL iniconst
-      CALL inigeom
-
-
-      print*,'OK1'
-      do j=1,jjp1
-         rlatudeg(j)=rlatu(j)*180./pi
-      enddo
-      do j=1,jjm
-         rlatvdeg(j)=rlatv(j)*180./pi
-      enddo
-
-      do i=1,iip1
-         rlonudeg(i)=rlonu(i)*180./pi + 360.
-         rlonvdeg(i)=rlonv(i)*180./pi + 360.
-      enddo
-
-
-      print*,'OK2'
-c  2 ----- OUVERTURE DE LA SORTIE NETCDF
-c ---------------------------------------------------
-c CREATION OUTPUT
-c ouverture fichier netcdf de sortie out
-        fich_out='grilles_gcm.nc'
-
-        status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out)
-        status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
-        status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
-        status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
-        status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
-
-
-      print*,'OK3'
-c   Longitudes en u
-        print *,'OUTID: ',ncid_out
-        status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim,
-     %  out_lonuid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units',
-     %  12,'degrees_east')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',
-     %  9,'Longitude en u')
-
-c   Longitudes en v
-        print *,'OUTID: ',ncid_out
-        status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim,
-     %  out_lonvid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units',
-     %  12,'degrees_east')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name',
-     %  9,'Longitude en v')
-
-c   Latitude en u
-        status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim,
-     %  out_latuid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units',
-     %  13,'degrees_north')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name',
-     %  8,'Latitude en u')
-
-c  Latitude en v
-        status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim,
-     %  out_latvid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units',
-     %  13,'degrees_north')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name',
-     %  8,'Latitude en v')
-
-c   ecriture de la grille u
-        out_dim(1)=out_lonudim
-        out_dim(2)=out_latudim
-        status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim,
-     %  out_varid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
-     %  6,'Kelvin')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
-     %  16,'Grille aux point u')
-
-c   ecriture de la grille v
-        out_dim(1)=out_lonvdim
-        out_dim(2)=out_latvdim
-        status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim,
-     %  out_varid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
-     %  6,'Kelvin')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
-     %  16,'Grille aux point v')
-
-c   ecriture de la grille u
-        out_dim(1)=out_lonvdim
-        out_dim(2)=out_latudim
-        status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim,
-     %  out_varid)
-        call handle_err(status)
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
-     %  6,'Kelvin')
-        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
-     %  16,'Grille aux point u')
-
-
-      print*,'OK4'
-        status=NF_ENDDEF(ncid_out)
-c 5) ----- FERMETURE DES FICHIERS NETCDF------------------
-c --------------------------------------------------------
-c 3-b- Ecriture de la grille pour la sortie
-c rajoute l'ecriture de la grille
-
-#ifdef NC_DOUBLE
-      status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
-      status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
-      status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
-      status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
-#else
-      status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
-      status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
-      status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
-      status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
-#endif
-
-        start(1)=1
-        start(2)=1
-        start(3)=1
-        start(4)=1
-
-        count(1)=iim+1
-        count(2)=jjm+1
-        count(3)=1
-        count(4)=1
-
-        do j=1,jjm+1
-           do i=1,iim+1
-              temp(i,j)=mod(i,2)+mod(j,2)
-           enddo
-        enddo
-
-#ifdef NC_DOUBLE
-        status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start,
-     s  count,temp)
-#else
-        status=NF_PUT_VARA_REAL(ncid_out,out_varid,start,
-     s  count,temp)
-#endif
-
-
-c fermeture du fichier netcdf
-        call ncclos(ncid_out,rcode_out)
-        write(*,*) 'Fermeture: ',fich_out
-
-
-      print*,'OK5'
-c   Ecriture grads
-      open (20,file='grille.dat',form='unformatted',access='direct'
-     s      ,recl=4*ip1jmp1)
-      write(20,rec=1) (( REAL(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
-      write(20,rec=2) (( REAL(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
-      do j=2,jjm
-         dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
-c        dlat2(j)=180.*fyprim( REAL(j))/pi
-      enddo
-      do i=2,iip1
-         dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
-c        dlon2(i)=180.*fxprim( REAL(i))/pi
-      enddo
-      do j=2,jjm
-         dykm=(rlatv(j)-rlatv(j-1))*6400.
-         acoslat=6400.*cos(rlatu(j))
-         do i=2,iip1
-            dxkm=acoslat*(rlonu(i)-rlonu(i-1))
-            resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm)
-         enddo
-         resol(1,j)=resol(iip1,j)
-      enddo
-      write(20,rec=3) resol
-      dlon1(1)=dlon1(iip1)
-      dlon2(1)=dlon2(iip1)
-      write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1)
-      write(20,rec=5) ((dlon1(i)*pi/180.*0.001*
-     s   cos(rlatu(j))*rad,i=1,iip1),j=1,jjp1)
-      write(20,rec=6) ((dlon2(i),i=1,iip1),j=1,jjp1)
-      write(20,rec=7) ((dlat1(j),i=1,iip1),j=1,jjp1)
-      write(20,rec=8) ((dlat1(j)*pi/180.*rad*0.001,i=1,iip1),j=1,jjp1)
-      write(20,rec=9) ((dlat2(j),i=1,iip1),j=1,jjp1)
-
-      print*,'I, LON, DX (km)'
-      do i=1,iip1
-         print*,i,rlonu(i)*180./pi,dlon1(i)*pi/180.*0.001*
-     s   cos(clat*pi/180.)*rad
-      enddo
-      print*,'J, LAT, DY (km)'
-      do j=1,jjp1
-         print*,j,rlatu(j)*180./pi,dlat1(j)*pi/180.*0.001*rad
-      enddo
-
-      open (21,file='grille.ctl',form='formatted')
-
-c   WARNING! on reecrase le fichier .ctl a chaque ecriture
-      write(21,'(a5,1x,a40)')
-     &       'DSET ','^grille.dat'
-
-      write(21,'(a12)') 'UNDEF 1.0E30'
-      write(21,'(a5,1x,a40)') 'TITLE ','grille'
-      call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF')
-      call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF')
-      call formcoord(21,1,0.,1.,.false.,'ZDEF')
-      write(21,'(a4,i10,a30)')
-     &       'TDEF ',1,' LINEAR 23OCT1994 3hr '
-      write(21,'(a4,2x,i5)') 'VARS',9
-      write(21,'(a18)') 'grille 0 99 grille'
-      write(21,'(a18)') 'gril   0 99 gril  '
-      write(21,'(a29)') 'resol   0 99 resolution (km)  '
-      write(21,'(a18)') 'dlon1  0 99 dlon1 '
-      write(21,'(a20)') 'dx     0 99 dx (km) '
-      write(21,'(a18)') 'dlon2  0 99 dlon2 '
-      write(21,'(a18)') 'dlat1  0 99 dlat1 '
-      write(21,'(a20)') 'dy     0 99 dy (km) '
-      write(21,'(a18)') 'dlat2  0 99 dlat2 '
-      write(21,'(a7)') 'ENDVARS'
-
-
-
-
-
-      print*,'OK6'
-	end
-
-
-
-        subroutine handle_err(status)
-#include "netcdf.inc"
-
-
-        integer status
-        print *,'handle code err: ',NF_NOERR
-        IF (status.NE.nf_noerr) THEN
-                print *,NF_STRERROR(status)
-                stop 'stopped'
-        ENDIF
-        END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90	(revision 1910)
+++ 	(revision )
@@ -1,237 +1,0 @@
-!
-! $Id$
-!
-! This subroutine creates the file grilles_gcm.nc containg longitudes and
-! latitudes in degrees for grid u and v. This subroutine is called from
-! ce0l if grilles_gcm_netcdf=TRUE. This subroutine corresponds to the first 
-! part in the program create_fausse_var.
-!
-SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)
-
-  IMPLICIT NONE
-
-  INCLUDE "dimensions.h"
-  INCLUDE "paramet.h"
-  INCLUDE "comconst.h"
-  INCLUDE "comgeom.h"
-  INCLUDE "comvert.h"
-  INCLUDE "netcdf.inc"
-  INCLUDE "serre.h"
-
-
-  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: masque ! masque terre/mer
-  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: phis   ! geopotentiel au sol
-
-  REAL temp(iim+1,jjm+1)
-  ! Attributs netcdf sortie
-  INTEGER ncid_out,rcode_out
-  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid
-  INTEGER out_varid
-  INTEGER out_lonudim,out_lonvdim
-  INTEGER out_latudim,out_latvdim,out_dim(3)
-  INTEGER out_levdim
-
-  INTEGER, PARAMETER :: longcles = 20
-  REAL  clesphy0(longcles)
-
-  INTEGER start(4),COUNT(4)
-
-  INTEGER status,i,j
-  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
-  REAL rlonudeg(iip1),rlonvdeg(iip1)
-
-  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
-  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
-  REAL,DIMENSION(iip1,jjp1)  :: phis_loc
-  INTEGER masque_int(iip1,jjp1)
-  INTEGER :: phis_id
-  INTEGER :: area_id
-  INTEGER :: mask_id
-  
-  rad = 6400000
-  omeg = 7.272205e-05
-  g = 9.8
-  kappa = 0.285716
-  daysec = 86400
-  cpp = 1004.70885
-
-  preff = 101325.
-  pa= 50000.
-
-  CALL conf_gcm( 99, .TRUE. , clesphy0 )
-  CALL iniconst
-  CALL inigeom
-
-  DO j=1,jjp1
-     rlatudeg(j)=rlatu(j)*180./pi
-  ENDDO
-  DO j=1,jjm
-     rlatvdeg(j)=rlatv(j)*180./pi
-  ENDDO
-
-  DO i=1,iip1
-     rlonudeg(i)=rlonu(i)*180./pi + 360.
-     rlonvdeg(i)=rlonv(i)*180./pi + 360.
-  ENDDO
-
-
-  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
-  ! ---------------------------------------------------
-  ! CREATION OUTPUT
-  ! ouverture fichier netcdf de sortie out
-  status=NF_CREATE('grilles_gcm.nc',NF_NOCLOBBER,ncid_out)
-  status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
-  status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
-  status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
-  status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
-
-
-  !   Longitudes en u
-  status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u')
-
-  !   Longitudes en v
-  status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v')
-
-  !   Latitude en u
-  status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u')
-
-  !  Latitude en v
-  status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v')
-
-  !   ecriture de la grille u
-  out_dim(1)=out_lonudim
-  out_dim(2)=out_latudim
-  status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u')
-
-  !   ecriture de la grille v
-  out_dim(1)=out_lonvdim
-  out_dim(2)=out_latvdim
-  status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v')
-
-  !   ecriture de la grille u
-  out_dim(1)=out_lonvdim
-  out_dim(2)=out_latudim
-  status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid)
-  CALL handle_err(status)
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin')
-  status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u')
-
-  status=NF_ENDDEF(ncid_out)
-  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
-  ! --------------------------------------------------------
-  ! 3-b- Ecriture de la grille pour la sortie
-  ! rajoute l'ecriture de la grille
-
-#ifdef NC_DOUBLE
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
-#else
-  status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
-  status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
-  status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
-  status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
-#endif
-
-  start(1)=1
-  start(2)=1
-  start(3)=1
-  start(4)=1
-
-  COUNT(1)=iim+1
-  COUNT(2)=jjm+1
-  COUNT(3)=1
-  COUNT(4)=1
-
-  DO j=1,jjm+1
-     DO i=1,iim+1
-        temp(i,j)=MOD(i,2)+MOD(j,2)
-     ENDDO
-  ENDDO
-
-#ifdef NC_DOUBLE
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp)
-#else
-  status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
-#endif
-
-  ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
-! lev - phis - aire - mask
-  rlevdeg(:) = presnivs
-  phis_loc(:,:) = phis(:,:)/g
-
-! niveaux de pression verticaux
-  status = NF_REDEF (ncid_out)
-  status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
-  
-! fields
-  out_dim(1)=out_lonvdim
-  out_dim(2)=out_latudim
-
-  status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id)
-  CALL handle_err(status)
-  status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id)
-  CALL handle_err(status)
-  status = nf_def_var(ncid_out,'mask',NF_INT  ,2,out_dim,mask_id)
-  CALL handle_err(status)
-
-  status=NF_ENDDEF(ncid_out)
-
-  ! ecriture des variables
-#ifdef NC_DOUBLE
-  status=NF_PUT_VARA_DOUBLE(ncid_out,out_levid,1,llm,rlevdeg)
-#else
-  status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg)
-#endif
-
-  start(1)=1
-  start(2)=1
-  start(3)=1
-  start(4)=0
-  COUNT(1)=iip1
-  COUNT(2)=jjp1
-  COUNT(3)=1
-  COUNT(4)=0
-
-  status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
-  status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
-  masque_int(:,:) = nINT(masque(:,:))
-  status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
-  CALL handle_err(status)
-  
-  ! fermeture du fichier netcdf
-  CALL ncclos(ncid_out,rcode_out)
-
-END SUBROUTINE grilles_gcm_netcdf_sub
-
-
-
-SUBROUTINE handle_err(status)
-  INCLUDE "netcdf.inc"
-
-  INTEGER status
-  IF (status.NE.nf_noerr) THEN
-     PRINT *,NF_STRERROR(status)
-     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
-  ENDIF
-END SUBROUTINE handle_err
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/heavyside.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/heavyside.F	(revision 1910)
+++ 	(revision )
@@ -1,23 +1,0 @@
-!
-! $Header$
-!
-c
-c
-       FUNCTION heavyside(a)
-
-c      ...   P. Le Van  ....
-c
-       IMPLICIT NONE
-
-       REAL(KIND=8) heavyside , a
-
-       IF ( a.LE.0. )  THEN
-         heavyside = 0.
-       ELSE
-         heavyside = 1.
-       ENDIF
-
-       RETURN
-       END
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/infotrac.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/infotrac.F90	(revision 1910)
+++ 	(revision )
@@ -1,390 +1,0 @@
-! $Id$
-!
-MODULE infotrac
-
-! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
-  INTEGER, SAVE :: nqtot
-
-! nbtr : number of tracers not including higher order of moment or water vapor or liquid
-!        number of tracers used in the physics
-  INTEGER, SAVE :: nbtr
-
-! Name variables
-  CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
-  CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
-
-! iadv  : index of trasport schema for each tracer
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
-
-! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 
-!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
-
-! conv_flg(it)=0 : convection desactivated for tracer number it 
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
-! pbl_flg(it)=0  : boundary layer diffusion desactivaded for tracer number it 
-  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
-
-  CHARACTER(len=4),SAVE :: type_trac
- 
-CONTAINS
-
-  SUBROUTINE infotrac_init
-    USE control_mod
-#ifdef REPROBUS
-    USE CHEM_REP, ONLY : Init_chem_rep_trac
-#endif
-    IMPLICIT NONE
-!=======================================================================
-!
-!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
-!   -------
-!   Modif special traceur F.Forget 05/94
-!   Modif M-A Filiberti 02/02 lecture de traceur.def
-!
-!   Objet:
-!   ------
-!   GCM LMD nouvelle grille
-!
-!=======================================================================
-!   ... modification de l'integration de q ( 26/04/94 ) ....
-!-----------------------------------------------------------------------
-! Declarations
-
-    INCLUDE "dimensions.h"
-    INCLUDE "iniprint.h"
-
-! Local variables
-    INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv  ! index of horizontal trasport schema
-    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv  ! index of vertical trasport schema
-
-    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
-    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
-    CHARACTER(len=3), DIMENSION(30) :: descrq
-    CHARACTER(len=1), DIMENSION(3)  :: txts
-    CHARACTER(len=2), DIMENSION(9)  :: txtp
-    CHARACTER(len=23)               :: str1,str2
-  
-    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
-    INTEGER :: iq, new_iq, iiq, jq, ierr
-
-    character(len=*),parameter :: modname="infotrac_init"
-!-----------------------------------------------------------------------
-! Initialization :
-!
-    txts=(/'x','y','z'/)
-    txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/)
-
-    descrq(14)='VLH'
-    descrq(10)='VL1'
-    descrq(11)='VLP'
-    descrq(12)='FH1'
-    descrq(13)='FH2'
-    descrq(16)='PPM'
-    descrq(17)='PPS'
-    descrq(18)='PPP'
-    descrq(20)='SLP'
-    descrq(30)='PRA'
-    
-
-    ! Coherence test between parameter type_trac, config_inca and preprocessing keys
-    IF (type_trac=='inca') THEN
-       WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
-            type_trac,' config_inca=',config_inca
-       IF (config_inca/='aero' .AND. config_inca/='chem') THEN
-          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
-          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
-       END IF
-#ifndef INCA
-       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
-       CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
-#endif
-    ELSE IF (type_trac=='repr') THEN
-       WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
-#ifndef REPROBUS
-       WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
-       CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
-#endif
-    ELSE IF (type_trac == 'lmdz') THEN
-       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
-    ELSE
-       WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
-       CALL abort_gcm('infotrac_init','bad parameter',1)
-    END IF
-
-
-    ! Test if config_inca is other then none for run without INCA
-    IF (type_trac/='inca' .AND. config_inca/='none') THEN
-       WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
-       config_inca='none'
-    END IF
-
-
-!-----------------------------------------------------------------------
-!
-! 1) Get the true number of tracers + water vapor/liquid
-!    Here true tracers (nqtrue) means declared tracers (only first order)
-!
-!-----------------------------------------------------------------------
-    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
-       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
-       IF(ierr.EQ.0) THEN
-          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
-          READ(90,*) nqtrue
-       ELSE 
-          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
-          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
-          if (planet_type=='earth') then
-            nqtrue=4 ! Default value for Earth
-          else
-            nqtrue=1 ! Default value for other planets
-          endif
-       END IF
-       if ( planet_type=='earth') then
-         ! For Earth, water vapour & liquid tracers are not in the physics
-         nbtr=nqtrue-2
-       else
-         ! Other planets (for now); we have the same number of tracers
-         ! in the dynamics than in the physics
-         nbtr=nqtrue
-       endif
-    ELSE ! type_trac=inca
-       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 
-       nqtrue=nbtr+2
-    END IF
-
-    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
-       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
-       CALL abort_gcm('infotrac_init','Not enough tracers',1)
-    END IF
-    
-! Transfert number of tracers to Reprobus
-    IF (type_trac == 'repr') THEN
-#ifdef REPROBUS
-       CALL Init_chem_rep_trac(nbtr)
-#endif
-    END IF
-       
-!
-! Allocate variables depending on nqtrue and nbtr
-!
-    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
-    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
-    conv_flg(:) = 1 ! convection activated for all tracers
-    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
-
-!-----------------------------------------------------------------------
-! 2)     Choix  des schemas d'advection pour l'eau et les traceurs
-!
-!     iadv = 1    schema  transport type "humidite specifique LMD"
-!     iadv = 2    schema   amont
-!     iadv = 14   schema  Van-leer + humidite specifique 
-!                            Modif F.Codron
-!     iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
-!     iadv = 11   schema  Van-Leer pour hadv et version PPM (Monotone) pour vadv
-!     iadv = 12   schema  Frederic Hourdin I
-!     iadv = 13   schema  Frederic Hourdin II
-!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
-!     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
-!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
-!     iadv = 20   schema  Slopes
-!     iadv = 30   schema  Prather
-!
-!        Dans le tableau q(ij,l,iq) : iq = 1  pour l'eau vapeur
-!                                     iq = 2  pour l'eau liquide
-!       Et eventuellement             iq = 3,nqtot pour les autres traceurs
-!
-!        iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
-!------------------------------------------------------------------------
-!
-!    Get choice of advection schema from file tracer.def or from INCA
-!---------------------------------------------------------------------
-    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
-       IF(ierr.EQ.0) THEN
-          ! Continue to read tracer.def
-          DO iq=1,nqtrue
-             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
-          END DO
-          CLOSE(90)  
-       ELSE ! Without tracer.def, set default values 
-         if (planet_type=="earth") then
-          ! for Earth, default is to have 4 tracers
-          hadv(1) = 14
-          vadv(1) = 14
-          tnom_0(1) = 'H2Ov'
-          hadv(2) = 10
-          vadv(2) = 10
-          tnom_0(2) = 'H2Ol'
-          hadv(3) = 10
-          vadv(3) = 10
-          tnom_0(3) = 'RN'
-          hadv(4) = 10
-          vadv(4) = 10
-          tnom_0(4) = 'PB'
-         else ! default for other planets
-          hadv(1) = 10
-          vadv(1) = 10
-          tnom_0(1) = 'dummy'
-         endif ! of if (planet_type=="earth")
-       END IF
-       
-       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
-       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
-       DO iq=1,nqtrue
-          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
-       END DO
-
-    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
-! le module de chimie fournit les noms des traceurs
-! et les schemas d'advection associes.
-     
-#ifdef INCA
-       CALL init_transport( &
-            hadv, &
-            vadv, &
-            conv_flg, &
-            pbl_flg,  &
-            tracnam)
-#endif
-       tnom_0(1)='H2Ov'
-       tnom_0(2)='H2Ol'
-
-       DO iq =3,nqtrue
-          tnom_0(iq)=tracnam(iq-2)
-       END DO
-
-    END IF ! type_trac
-
-!-----------------------------------------------------------------------
-!
-! 3) Verify if advection schema 20 or 30 choosen
-!    Calculate total number of tracers needed: nqtot
-!    Allocate variables depending on total number of tracers
-!-----------------------------------------------------------------------
-    new_iq=0
-    DO iq=1,nqtrue
-       ! Add tracers for certain advection schema
-       IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
-          new_iq=new_iq+1  ! no tracers added
-       ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
-          new_iq=new_iq+4  ! 3 tracers added
-       ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
-          new_iq=new_iq+10 ! 9 tracers added
-       ELSE
-          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
-          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
-       END IF
-    END DO
-    
-    IF (new_iq /= nqtrue) THEN
-       ! The choice of advection schema imposes more tracers
-       ! Assigne total number of tracers
-       nqtot = new_iq
-
-       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
-       WRITE(lunout,*) 'makes it necessary to add tracers'
-       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
-       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
-
-    ELSE
-       ! The true number of tracers is also the total number
-       nqtot = nqtrue
-    END IF
-
-!
-! Allocate variables with total number of tracers, nqtot
-!
-    ALLOCATE(tname(nqtot), ttext(nqtot))
-    ALLOCATE(iadv(nqtot), niadv(nqtot))
-
-!-----------------------------------------------------------------------
-!
-! 4) Determine iadv, long and short name
-!
-!-----------------------------------------------------------------------
-    new_iq=0
-    DO iq=1,nqtrue
-       new_iq=new_iq+1
-
-       ! Verify choice of advection schema
-       IF (hadv(iq)==vadv(iq)) THEN
-          iadv(new_iq)=hadv(iq)
-       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
-          iadv(new_iq)=11
-       ELSE
-          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
-
-          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
-       END IF
-      
-       str1=tnom_0(iq)
-       tname(new_iq)= tnom_0(iq)
-       IF (iadv(new_iq)==0) THEN
-          ttext(new_iq)=trim(str1)
-       ELSE
-          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
-       END IF
-
-       ! schemas tenant compte des moments d'ordre superieur
-       str2=ttext(new_iq)
-       IF (iadv(new_iq)==20) THEN
-          DO jq=1,3
-             new_iq=new_iq+1
-             iadv(new_iq)=-20
-             ttext(new_iq)=trim(str2)//txts(jq)
-             tname(new_iq)=trim(str1)//txts(jq)
-          END DO
-       ELSE IF (iadv(new_iq)==30) THEN
-          DO jq=1,9
-             new_iq=new_iq+1
-             iadv(new_iq)=-30
-             ttext(new_iq)=trim(str2)//txtp(jq)
-             tname(new_iq)=trim(str1)//txtp(jq)
-          END DO
-       END IF
-    END DO
-
-!
-! Find vector keeping the correspodence between true and total tracers
-!
-    niadv(:)=0
-    iiq=0
-    DO iq=1,nqtot
-       IF(iadv(iq).GE.0) THEN
-          ! True tracer
-          iiq=iiq+1
-          niadv(iiq)=iq
-       ENDIF
-    END DO
-
-
-    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
-    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
-    DO iq=1,nqtot
-       WRITE(lunout,*) iadv(iq),niadv(iq),&
-       ' ',trim(tname(iq)),' ',trim(ttext(iq))
-    END DO
-
-!
-! Test for advection schema. 
-! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
-!
-    DO iq=1,nqtot
-       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
-          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
-          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
-       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
-          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
-          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
-       END IF
-    END DO
-
-!-----------------------------------------------------------------------
-! Finalize :
-!
-    DEALLOCATE(tnom_0, hadv, vadv)
-    DEALLOCATE(tracnam)
-
-  END SUBROUTINE infotrac_init
-
-END MODULE infotrac
Index: LMDZ5/branches/testing/libf/dyn3dmem/iniconst.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/iniconst.F90	(revision 1910)
+++ 	(revision )
@@ -1,84 +1,0 @@
-!
-! $Id: iniconst.F90 1625 2012-05-09 13:14:48Z lguez $
-!
-SUBROUTINE iniconst
-
-  USE control_mod
-#ifdef CPP_IOIPSL
-  use IOIPSL
-#else
-  ! if not using IOIPSL, we still need to use (a local version of) getin
-  use ioipsl_getincom
-#endif
-
-  IMPLICIT NONE
-  !
-  !      P. Le Van
-  !
-  !   Declarations:
-  !   -------------
-  !
-  include "dimensions.h"
-  include "paramet.h"
-  include "comconst.h"
-  include "temps.h"
-  include "comvert.h"
-  include "iniprint.h"
-
-  character(len=*),parameter :: modname="iniconst"
-  character(len=80) :: abort_message
-  !
-  !
-  !
-  !-----------------------------------------------------------------------
-  !   dimension des boucles:
-  !   ----------------------
-
-  im      = iim
-  jm      = jjm
-  lllm    = llm
-  imp1    = iim 
-  jmp1    = jjm + 1
-  lllmm1  = llm - 1
-  lllmp1  = llm + 1
-
-  !-----------------------------------------------------------------------
-
-  dtphys  = iphysiq * dtvr
-  unsim   = 1./iim
-  pi      = 2.*ASIN( 1. )
-
-  !-----------------------------------------------------------------------
-  !
-
-  r       = cpp * kappa
-
-  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
-  !
-  !-----------------------------------------------------------------------
-
-  ! vertical discretization: default behavior depends on planet_type flag
-  if (planet_type=="earth") then
-     disvert_type=1
-  else
-     disvert_type=2
-  endif
-  ! but user can also specify using one or the other in run.def:
-  call getin('disvert_type',disvert_type)
-  write(lunout,*) trim(modname),': disvert_type=',disvert_type
-
-  pressure_exner = disvert_type == 1 ! default value
-  call getin('pressure_exner', pressure_exner)
-
-  if (disvert_type==1) then
-     ! standard case for Earth (automatic generation of levels)
-     call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight)
-  else if (disvert_type==2) then
-     ! standard case for planets (levels generated using z2sig.def file)
-     call disvert_noterre
-  else
-     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
-     call abort_gcm(modname,abort_message,0)
-  endif
-
-END SUBROUTINE iniconst
Index: LMDZ5/branches/testing/libf/dyn3dmem/inidissip.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/inidissip.F90	(revision 1910)
+++ 	(revision )
@@ -1,223 +1,0 @@
-!
-! $Id: inidissip.F90 1611 2012-01-25 14:31:54Z lguez $
-!
-SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  , &
-     tetagdiv,tetagrot,tetatemp, vert_prof_dissip)
-  !=======================================================================
-  !   initialisation de la dissipation horizontale
-  !=======================================================================
-  !-----------------------------------------------------------------------
-  !   declarations:
-  !   -------------
-
-  USE control_mod, only : dissip_period,iperiod
-
-  IMPLICIT NONE
-  include "dimensions.h"
-  include "paramet.h"
-  include "comdissipn.h"
-  include "comconst.h"
-  include "comvert.h"
-  include "logic.h"
-  include "iniprint.h"
-
-  LOGICAL,INTENT(in) :: lstardis
-  INTEGER,INTENT(in) :: nitergdiv,nitergrot,niterh
-  REAL,INTENT(in) :: tetagdiv,tetagrot,tetatemp
-
-  integer, INTENT(in):: vert_prof_dissip
-  ! Vertical profile of horizontal dissipation
-  ! Allowed values:
-  ! 0: rational fraction, function of pressure
-  ! 1: tanh of altitude
-
-! Local variables:
-  REAL fact,zvert(llm),zz
-  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
-  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
-  REAL ullm,vllm,umin,vmin,zhmin,zhmax
-  REAL zllm
-
-  INTEGER l,ij,idum,ii
-  REAL tetamin
-  REAL pseudoz
-  character (len=80) :: abort_message
-
-  REAL ran1
-
-
-  !-----------------------------------------------------------------------
-  !
-  !   calcul des valeurs propres des operateurs par methode iterrative:
-  !   -----------------------------------------------------------------
-
-  crot     = -1.
-  cdivu    = -1.
-  cdivh    = -1.
-
-  !   calcul de la valeur propre de divgrad:
-  !   --------------------------------------
-  idum = 0
-  DO l = 1, llm
-     DO ij = 1, ip1jmp1
-        deltap(ij,l) = 1.
-     ENDDO
-  ENDDO
-
-  idum  = -1
-  zh(1) = RAN1(idum)-.5
-  idum  = 0
-  DO ij = 2, ip1jmp1
-     zh(ij) = RAN1(idum) -.5
-  ENDDO
-
-  CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
-
-  CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-  IF ( zhmin .GE. zhmax  )     THEN
-     write(lunout,*)'  Inidissip  zh min max  ',zhmin,zhmax
-     abort_message='probleme generateur alleatoire dans inidissip'
-     call abort_gcm('inidissip',abort_message,1)
-  ENDIF
-
-  zllm = ABS( zhmax )
-  DO l = 1,50
-     IF(lstardis) THEN
-        CALL divgrad2(1,zh,deltap,niterh,divgra)
-     ELSE
-        CALL divgrad (1,zh,niterh,divgra)
-     ENDIF
-
-     zllm  = ABS(maxval(divgra))
-     zh = divgra / zllm
-  ENDDO
-
-  IF(lstardis) THEN
-     cdivh = 1./ zllm
-  ELSE
-     cdivh = zllm ** ( -1./niterh )
-  ENDIF
-
-  !   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
-  !   -----------------------------------------------------------------
-  write(lunout,*)'inidissip: calcul des valeurs propres'
-
-  DO    ii = 1, 2
-     !
-     DO ij = 1, ip1jmp1
-        zu(ij)  = RAN1(idum) -.5
-     ENDDO
-     CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
-     DO ij = 1, ip1jm
-        zv(ij) = RAN1(idum) -.5
-     ENDDO
-     CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
-
-     CALL minmax(iip1*jjp1,zu,umin,ullm )
-     CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-     ullm = ABS ( ullm )
-     vllm = ABS ( vllm )
-
-     DO    l = 1, 50
-        IF(ii.EQ.1) THEN
-           !cccc             CALL covcont( 1,zu,zv,zu,zv )
-           IF(lstardis) THEN
-              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
-           ELSE
-              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
-           ENDIF
-        ELSE
-           IF(lstardis) THEN
-              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
-           ELSE
-              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
-           ENDIF
-        ENDIF
-
-        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
-        zu = gx / zllm
-        zv = gy / zllm
-     end DO
-
-     IF ( ii.EQ.1 ) THEN
-        IF(lstardis) THEN
-           cdivu  = 1./zllm
-        ELSE
-           cdivu  = zllm **( -1./nitergdiv )
-        ENDIF
-     ELSE
-        IF(lstardis) THEN
-           crot   = 1./ zllm
-        ELSE
-           crot   = zllm **( -1./nitergrot )
-        ENDIF
-     ENDIF
-
-  end DO
-
-  !   petit test pour les operateurs non star:
-  !   ----------------------------------------
-
-  !     IF(.NOT.lstardis) THEN
-  fact    = rad*24./REAL(jjm)
-  fact    = fact*fact
-  write(lunout,*)'inidissip: coef u ', fact/cdivu, 1./cdivu
-  write(lunout,*)'inidissip: coef r ', fact/crot , 1./crot
-  write(lunout,*)'inidissip: coef h ', fact/cdivh, 1./cdivh
-  !     ENDIF
-
-  !-----------------------------------------------------------------------
-  !   variation verticale du coefficient de dissipation:
-  !   --------------------------------------------------
-
-  if (vert_prof_dissip == 1) then
-     do l=1,llm
-        pseudoz=8.*log(preff/presnivs(l))
-        zvert(l)=1+ &
-             (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2. &
-             *(dissip_factz-1.)
-     enddo
-  else
-     DO l=1,llm
-        zvert(l)=1.
-     ENDDO
-     fact=2.
-     DO l = 1, llm
-        zz      = 1. - preff/presnivs(l)
-        zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
-     ENDDO
-  endif
-
-
-  write(lunout,*)'inidissip: Constantes de temps de la diffusion horizontale'
-
-  tetamin =  1.e+6
-
-  DO l=1,llm
-     tetaudiv(l)   = zvert(l)/tetagdiv
-     tetaurot(l)   = zvert(l)/tetagrot
-     tetah(l)      = zvert(l)/tetatemp
-
-     IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
-     IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
-     IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
-  ENDDO
-
-  ! If dissip_period=0 calculate value for dissipation period, else keep value read from gcm.def
-  IF (dissip_period == 0) THEN
-     dissip_period = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
-     write(lunout,*)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ',tetamin,dtvr,iperiod,dissip_period
-     dissip_period = MAX(iperiod,dissip_period)
-  END IF
-
-  dtdiss  = dissip_period * dtvr
-  write(lunout,*)'inidissip: dissip_period=',dissip_period,' dtdiss=',dtdiss,' dtvr=',dtvr
-
-  DO l = 1,llm
-     write(lunout,*)zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l), &
-          dtdiss*tetah(l)
-  ENDDO
-
-END SUBROUTINE inidissip
Index: LMDZ5/branches/testing/libf/dyn3dmem/inigeom.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/inigeom.F	(revision 1910)
+++ 	(revision )
@@ -1,699 +1,0 @@
-!
-! $Id: inigeom.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-      SUBROUTINE inigeom
-c
-c     Auteur :  P. Le Van
-c
-c   ............      Version  du 01/04/2001     ........................
-c
-c  Calcul des elongations cuij1,.cuij4 , cvij1,..cvij4  aux memes en-
-c     endroits que les aires aireij1,..aireij4 .
-
-c  Choix entre f(y) a derivee sinusoid. ou a derivee tangente hyperbol.
-c
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom2.h"
-#include "serre.h"
-#include "logic.h"
-#include "comdissnew.h"
-
-c-----------------------------------------------------------------------
-c   ....  Variables  locales   ....
-c
-      INTEGER  i,j,itmax,itmay,iter
-      REAL cvu(iip1,jjp1),cuv(iip1,jjm)
-      REAL ai14,ai23,airez,rlatp,rlatm,xprm,xprp,un4rad2,yprp,yprm
-      REAL eps,x1,xo1,f,df,xdm,y1,yo1,ydm
-      REAL coslatm,coslatp,radclatm,radclatp
-      REAL cuij1(iip1,jjp1),cuij2(iip1,jjp1),cuij3(iip1,jjp1),
-     *     cuij4(iip1,jjp1)
-      REAL cvij1(iip1,jjp1),cvij2(iip1,jjp1),cvij3(iip1,jjp1),
-     *     cvij4(iip1,jjp1)
-      REAL rlonvv(iip1),rlatuu(jjp1)
-      REAL rlatu1(jjm),yprimu1(jjm),rlatu2(jjm),yprimu2(jjm) ,
-     *     yprimv(jjm),yprimu(jjp1)
-      REAL gamdi_gdiv, gamdi_grot, gamdi_h
- 
-      REAL rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),
-     ,  xprimp025(iip1)
-      SAVE rlatu1,yprimu1,rlatu2,yprimu2,yprimv,yprimu
-      SAVE rlonm025,xprimm025,rlonp025,xprimp025
-
-      REAL      SSUM
-c
-c
-c   ------------------------------------------------------------------
-c   -                                                                -
-c   -    calcul des coeff. ( cu, cv , 1./cu**2,  1./cv**2  )         -
-c   -                                                                -
-c   ------------------------------------------------------------------
-c
-c      les coef. ( cu, cv ) permettent de passer des vitesses naturelles
-c      aux vitesses covariantes et contravariantes , ou vice-versa ...
-c
-c
-c     on a :  u (covariant) = cu * u (naturel)   , u(contrav)= u(nat)/cu
-c             v (covariant) = cv * v (naturel)   , v(contrav)= v(nat)/cv
-c
-c       on en tire :  u(covariant) = cu * cu * u(contravariant)
-c                     v(covariant) = cv * cv * v(contravariant)
-c
-c
-c     on a l'application (  x(X) , y(Y) )   avec - im/2 +1 <  X  < im/2
-c                                                          =     =
-c                                           et   - jm/2    <  Y  < jm/2
-c                                                          =     =
-c
-c      ...................................................
-c      ...................................................
-c      .  x  est la longitude du point  en radians       .
-c      .  y  est la  latitude du point  en radians       .
-c      .                                                 .
-c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
-c      .          cv( j ) = rad          * dy/dY         .
-c      .        aire(i,j) =  cu(i,j) * cv(j)             .
-c      .                                                 .
-c      . y, dx/dX, dy/dY calcules aux points concernes   .
-c      .                                                 .
-c      ...................................................
-c      ...................................................
-c
-c
-c
-c                                                           ,
-c    cv , bien que dependant de j uniquement,sera ici indice aussi en i
-c          pour un adressage plus facile en  ij  .
-c
-c
-c
-c  **************  aux points  u  et  v ,           *****************
-c      xprimu et xprimv sont respectivement les valeurs de  dx/dX
-c      yprimu et yprimv    .  .  .  .  .  .  .  .  .  .  .  dy/dY
-c      rlatu  et  rlatv    .  .  .  .  .  .  .  .  .  .  .la latitude
-c      cvu    et   cv      .  .  .  .  .  .  .  .  .  .  .    cv
-c
-c  **************  aux points u, v, scalaires, et z  ****************
-c      cu, cuv, cuscal, cuz sont respectiv. les valeurs de    cu
-c
-c
-c
-c         Exemple de distribution de variables sur la grille dans le
-c             domaine de travail ( X,Y ) .
-c     ................................................................
-c                  DX=DY= 1
-c
-c   
-c        +     represente  un  point scalaire ( p.exp  la pression )
-c        >     represente  la composante zonale du  vent
-c        V     represente  la composante meridienne du vent
-c        o     represente  la  vorticite
-c
-c       ----  , car aux poles , les comp.zonales covariantes sont nulles
-c
-c
-c
-c         i ->
-c
-c         1      2      3      4      5      6      7      8
-c  j
-c  v  1   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
-c
-c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
-c
-c     2   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
-c
-c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
-c
-c     3   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
-c
-c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
-c
-c     4   +   >  +   >  +   >  +   >  +   >  +   >  +   >  +  >
-c
-c         V   o  V   o  V   o  V   o  V   o  V   o  V   o  V  o
-c
-c     5   + ---- + ---- + ---- + ---- + ---- + ---- + ---- + --
-c
-c
-c      Ci-dessus,  on voit que le nombre de pts.en longitude est egal
-c                 a   IM = 8
-c      De meme ,   le nombre d'intervalles entre les 2 poles est egal
-c                 a   JM = 4
-c
-c      Les points scalaires ( + ) correspondent donc a des valeurs
-c       entieres  de  i ( 1 a IM )   et  de  j ( 1 a  JM +1 )   .
-c
-c      Les vents    U       ( > ) correspondent a des valeurs  semi-
-c       entieres  de i ( 1+ 0.5 a IM+ 0.5) et entieres de j ( 1 a JM+1)
-c
-c      Les vents    V       ( V ) correspondent a des valeurs entieres
-c       de     i ( 1 a  IM ) et semi-entieres de  j ( 1 +0.5  a JM +0.5)
-c
-c
-c
-      WRITE(6,3) 
- 3    FORMAT( // 10x,' ....  INIGEOM  date du 01/06/98   ..... ',
-     * //5x,'   Calcul des elongations cu et cv  comme sommes des 4 ' /
-     *  5x,' elong. cuij1, .. 4  , cvij1,.. 4  qui les entourent , aux 
-     * '/ 5x,' memes endroits que les aires aireij1,...j4   . ' / )
-c
-c
-      IF( nitergdiv.NE.2 ) THEN
-        gamdi_gdiv = coefdis/ ( REAL(nitergdiv) -2. )
-      ELSE
-        gamdi_gdiv = 0.
-      ENDIF
-      IF( nitergrot.NE.2 ) THEN
-        gamdi_grot = coefdis/ ( REAL(nitergrot) -2. )
-      ELSE
-        gamdi_grot = 0.
-      ENDIF
-      IF( niterh.NE.2 ) THEN
-        gamdi_h = coefdis/ ( REAL(niterh) -2. )
-      ELSE
-        gamdi_h = 0.
-      ENDIF
-
-      WRITE(6,*) ' gamdi_gd ',gamdi_gdiv,gamdi_grot,gamdi_h,coefdis,
-     *  nitergdiv,nitergrot,niterh
-c
-      pi    = 2.* ASIN(1.)
-c
-      WRITE(6,990) 
-
-c     ----------------------------------------------------------------
-c
-      IF( .NOT.fxyhypb )   THEN
-c
-c
-       IF( ysinus )  THEN
-c
-        WRITE(6,*) ' ***  Inigeom ,  Y = Sinus ( Latitude ) *** '
-c
-c   .... utilisation de f(x,y )  avec  y  =  sinus de la latitude  .....
-
-        CALL  fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
-     ,                    rlatu2,yprimu2,
-     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-       ELSE
-c
-        WRITE(6,*) '*** Inigeom ,  Y = Latitude  , der. sinusoid . ***'
-
-c  .... utilisation  de f(x,y) a tangente sinusoidale , y etant la latit. ...
-c
- 
-        pxo   = clon *pi /180.
-        pyo   = 2.* clat* pi /180.
-c
-c  ....  determination de  transx ( pour le zoom ) par Newton-Raphson ...
-c
-        itmax = 10
-        eps   = .1e-7
-c
-        xo1 = 0.
-        DO 10 iter = 1, itmax
-        x1  = xo1
-        f   = x1+ alphax *SIN(x1-pxo)
-        df  = 1.+ alphax *COS(x1-pxo)
-        x1  = x1 - f/df
-        xdm = ABS( x1- xo1 )
-        IF( xdm.LE.eps )GO TO 11
-        xo1 = x1
- 10     CONTINUE
- 11     CONTINUE
-c
-        transx = xo1
-
-        itmay = 10
-        eps   = .1e-7
-C
-        yo1  = 0.
-        DO 15 iter = 1,itmay
-        y1   = yo1
-        f    = y1 + alphay* SIN(y1-pyo)
-        df   = 1. + alphay* COS(y1-pyo)
-        y1   = y1 -f/df
-        ydm  = ABS(y1-yo1)
-        IF(ydm.LE.eps) GO TO 17
-        yo1  = y1
- 15     CONTINUE
-c
- 17     CONTINUE
-        transy = yo1
-
-        CALL fxy ( rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
-     ,              rlatu2,yprimu2,
-     ,  rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
-
-       ENDIF
-c
-      ELSE
-c
-c   ....  Utilisation  de fxyhyper , f(x,y) a derivee tangente hyperbol.
-c   .....................................................................
-
-      WRITE(6,*)'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
- 
-       CALL fxyhyper( clat, grossismy, dzoomy, tauy    , 
-     ,                clon, grossismx, dzoomx, taux    ,
-     , rlatu,yprimu,rlatv, yprimv,rlatu1, yprimu1,rlatu2,yprimu2  ,
-     , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025 )
-
-  
-      ENDIF
-c
-c  -------------------------------------------------------------------
-
-c
-      rlatu(1)    =     ASIN(1.)
-      rlatu(jjp1) =  - rlatu(1)
-c
-c
-c   ....  calcul  aux  poles  ....
-c
-      yprimu(1)      = 0.
-      yprimu(jjp1)   = 0.
-c
-c
-      un4rad2 = 0.25 * rad * rad
-c
-c   --------------------------------------------------------------------
-c   --------------------------------------------------------------------
-c   -                                                                  -
-c   -  calcul  des aires ( aire,aireu,airev, 1./aire, 1./airez  )      -
-c   -      et de   fext ,  force de coriolis  extensive  .             -
-c   -                                                                  -
-c   --------------------------------------------------------------------
-c   --------------------------------------------------------------------
-c
-c
-c
-c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
-c   affectees 4 aires entourant P , calculees respectivement aux points
-c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
-c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
-c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
-c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
-c
-c           ,
-c   Les cotes de chacun de ces 4 carres etant egaux a 1/2 suivant (X,Y).
-c   Chaque aire centree en 1 point scalaire P(i,j) est egale a la somme
-c   des 4 aires  aireij1,aireij2,aireij3,aireij4 qui sont affectees au
-c   point (i,j) .
-c   On definit en outre les coefficients  alpha comme etant egaux a
-c    (aireij / aire), c.a.d par exp.  alpha1(i,j)=aireij1(i,j)/aire(i,j)
-c
-c   De meme, toute aire centree en 1 point U est egale a la somme des
-c   4 aires aireij1,aireij2,aireij3,aireij4 entourant le point U .
-c    Idem pour  airev, airez .
-c
-c       On a ,pour chaque maille :    dX = dY = 1
-c
-c
-c                             . V
-c
-c                 aireij4 .        . aireij1
-c
-c                   U .       . P      . U
-c
-c                 aireij3 .        . aireij2
-c
-c                             . V
-c
-c
-c
-c
-c
-c   ....................................................................
-c
-c    Calcul des 4 aires elementaires aireij1,aireij2,aireij3,aireij4
-c   qui entourent chaque aire(i,j) , ainsi que les 4 elongations elemen
-c   taires cuij et les 4 elongat. cvij qui sont calculees aux memes 
-c     endroits  que les aireij   .    
-c
-c   ....................................................................
-c
-c     .......  do 35  :   boucle sur les  jjm + 1  latitudes   .....
-c
-c
-      DO 35 j = 1, jjp1
-c
-      IF ( j. eq. 1 )  THEN
-c
-      yprm           = yprimu1(j)
-      rlatm          = rlatu1(j)
-c
-      coslatm        = COS( rlatm )
-      radclatm       = 0.5* rad * coslatm
-c
-      DO 30 i = 1, iim
-      xprp           = xprimp025( i )
-      xprm           = xprimm025( i )
-      aireij2( i,1 ) = un4rad2 * coslatm  * xprp * yprm
-      aireij3( i,1 ) = un4rad2 * coslatm  * xprm * yprm
-      cuij2  ( i,1 ) = radclatm * xprp
-      cuij3  ( i,1 ) = radclatm * xprm
-      cvij2  ( i,1 ) = 0.5* rad * yprm
-      cvij3  ( i,1 ) = cvij2(i,1)
-  30  CONTINUE
-c
-      DO  i = 1, iim
-      aireij1( i,1 ) = 0.
-      aireij4( i,1 ) = 0.
-      cuij1  ( i,1 ) = 0.
-      cuij4  ( i,1 ) = 0.
-      cvij1  ( i,1 ) = 0.
-      cvij4  ( i,1 ) = 0.
-      ENDDO
-c
-      END IF
-c
-      IF ( j. eq. jjp1 )  THEN
-       yprp               = yprimu2(j-1)
-       rlatp              = rlatu2 (j-1)
-ccc       yprp             = fyprim( REAL(j) - 0.25 )
-ccc       rlatp            = fy    ( REAL(j) - 0.25 )
-c
-      coslatp             = COS( rlatp )
-      radclatp            = 0.5* rad * coslatp
-c
-      DO 31 i = 1,iim
-        xprp              = xprimp025( i )
-        xprm              = xprimm025( i )
-        aireij1( i,jjp1 ) = un4rad2 * coslatp  * xprp * yprp
-        aireij4( i,jjp1 ) = un4rad2 * coslatp  * xprm * yprp
-        cuij1(i,jjp1)     = radclatp * xprp
-        cuij4(i,jjp1)     = radclatp * xprm
-        cvij1(i,jjp1)     = 0.5 * rad* yprp
-        cvij4(i,jjp1)     = cvij1(i,jjp1)
- 31   CONTINUE
-c
-       DO   i    = 1, iim
-        aireij2( i,jjp1 ) = 0.
-        aireij3( i,jjp1 ) = 0.
-        cvij2  ( i,jjp1 ) = 0.
-        cvij3  ( i,jjp1 ) = 0.
-        cuij2  ( i,jjp1 ) = 0.
-        cuij3  ( i,jjp1 ) = 0.
-       ENDDO
-c
-      END IF
-c
-
-      IF ( j .gt. 1 .AND. j .lt. jjp1 )  THEN
-c
-        rlatp    = rlatu2 ( j-1 )
-        yprp     = yprimu2( j-1 )
-        rlatm    = rlatu1 (  j  )
-        yprm     = yprimu1(  j  )
-cc         rlatp    = fy    ( REAL(j) - 0.25 )
-cc         yprp     = fyprim( REAL(j) - 0.25 )
-cc         rlatm    = fy    ( REAL(j) + 0.25 )
-cc         yprm     = fyprim( REAL(j) + 0.25 )
-
-         coslatm  = COS( rlatm )
-         coslatp  = COS( rlatp )
-         radclatp = 0.5* rad * coslatp
-         radclatm = 0.5* rad * coslatm
-c
-         ai14            = un4rad2 * coslatp * yprp
-         ai23            = un4rad2 * coslatm * yprm
-         DO 32 i = 1,iim
-         xprp            = xprimp025( i )
-         xprm            = xprimm025( i )
-      
-         aireij1 ( i,j ) = ai14 * xprp
-         aireij2 ( i,j ) = ai23 * xprp
-         aireij3 ( i,j ) = ai23 * xprm
-         aireij4 ( i,j ) = ai14 * xprm
-         cuij1   ( i,j ) = radclatp * xprp
-         cuij2   ( i,j ) = radclatm * xprp
-         cuij3   ( i,j ) = radclatm * xprm
-         cuij4   ( i,j ) = radclatp * xprm
-         cvij1   ( i,j ) = 0.5* rad * yprp
-         cvij2   ( i,j ) = 0.5* rad * yprm
-         cvij3   ( i,j ) = cvij2(i,j)
-         cvij4   ( i,j ) = cvij1(i,j)
-  32     CONTINUE
-c
-      END IF
-c
-c    ........       periodicite   ............
-c
-         cvij1   (iip1,j) = cvij1   (1,j)
-         cvij2   (iip1,j) = cvij2   (1,j)
-         cvij3   (iip1,j) = cvij3   (1,j)
-         cvij4   (iip1,j) = cvij4   (1,j)
-         cuij1   (iip1,j) = cuij1   (1,j)
-         cuij2   (iip1,j) = cuij2   (1,j)
-         cuij3   (iip1,j) = cuij3   (1,j)
-         cuij4   (iip1,j) = cuij4   (1,j)
-         aireij1 (iip1,j) = aireij1 (1,j )
-         aireij2 (iip1,j) = aireij2 (1,j )
-         aireij3 (iip1,j) = aireij3 (1,j )
-         aireij4 (iip1,j) = aireij4 (1,j )
-        
-  35  CONTINUE
-c
-c    ..............................................................
-c
-      DO 37 j = 1, jjp1
-      DO 36 i = 1, iim
-      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
-     *                          aireij4(i,j)
-      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
-      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
-      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
-      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
-      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
-      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
-      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
-      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
-  36  CONTINUE
-c
-c
-      aire    (iip1,j) = aire    (1,j)
-      alpha1  (iip1,j) = alpha1  (1,j)
-      alpha2  (iip1,j) = alpha2  (1,j)
-      alpha3  (iip1,j) = alpha3  (1,j)
-      alpha4  (iip1,j) = alpha4  (1,j)
-      alpha1p2(iip1,j) = alpha1p2(1,j)
-      alpha1p4(iip1,j) = alpha1p4(1,j)
-      alpha2p3(iip1,j) = alpha2p3(1,j)
-      alpha3p4(iip1,j) = alpha3p4(1,j)
-  37  CONTINUE
-c
-
-      DO 42 j = 1,jjp1
-      DO 41 i = 1,iim
-      aireu       (i,j)= aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
-     *                                aireij3(i+1,j)
-      unsaire    ( i,j)= 1./ aire(i,j)
-      unsair_gam1( i,j)= unsaire(i,j)** ( - gamdi_gdiv )
-      unsair_gam2( i,j)= unsaire(i,j)** ( - gamdi_h    )
-      airesurg   ( i,j)= aire(i,j)/ g
-  41  CONTINUE
-      aireu     (iip1,j)  = aireu  (1,j)
-      unsaire   (iip1,j)  = unsaire(1,j)
-      unsair_gam1(iip1,j) = unsair_gam1(1,j)
-      unsair_gam2(iip1,j) = unsair_gam2(1,j)
-      airesurg   (iip1,j) = airesurg(1,j)
-  42  CONTINUE
-c
-c
-      DO 48 j = 1,jjm
-c
-        DO i=1,iim
-         airev     (i,j) = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
-     *                           aireij4(i,j+1)
-        ENDDO
-         DO i=1,iim
-          airez         = aireij2(i,j)+aireij1(i,j+1)+aireij3(i+1,j) +
-     *                           aireij4(i+1,j+1)
-          unsairez(i,j) = 1./ airez
-          unsairz_gam(i,j)= unsairez(i,j)** ( - gamdi_grot )
-          fext    (i,j)   = airez * SIN(rlatv(j))* 2.* omeg
-         ENDDO
-        airev     (iip1,j)  = airev(1,j)
-        unsairez  (iip1,j)  = unsairez(1,j)
-        fext      (iip1,j)  = fext(1,j)
-        unsairz_gam(iip1,j) = unsairz_gam(1,j)
-c
-  48  CONTINUE
-c
-c
-c    .....      Calcul  des elongations cu,cv, cvu     .........
-c
-      DO    j   = 1, jjm
-       DO   i  = 1, iim
-       cv(i,j) = 0.5 *( cvij2(i,j)+cvij3(i,j)+cvij1(i,j+1)+cvij4(i,j+1))
-       cvu(i,j)= 0.5 *( cvij1(i,j)+cvij4(i,j)+cvij2(i,j)  +cvij3(i,j) )
-       cuv(i,j)= 0.5 *( cuij2(i,j)+cuij3(i,j)+cuij1(i,j+1)+cuij4(i,j+1))
-       unscv2(i,j) = 1./ ( cv(i,j)*cv(i,j) )
-       ENDDO
-       DO   i  = 1, iim
-       cuvsurcv (i,j)    = airev(i,j)  * unscv2(i,j)
-       cvsurcuv (i,j)    = 1./cuvsurcv(i,j)
-       cuvscvgam1(i,j)   = cuvsurcv (i,j) ** ( - gamdi_gdiv )
-       cuvscvgam2(i,j)   = cuvsurcv (i,j) ** ( - gamdi_h )
-       cvscuvgam(i,j)    = cvsurcuv (i,j) ** ( - gamdi_grot )
-       ENDDO
-       cv       (iip1,j)  = cv       (1,j)
-       cvu      (iip1,j)  = cvu      (1,j)
-       unscv2   (iip1,j)  = unscv2   (1,j)
-       cuv      (iip1,j)  = cuv      (1,j)
-       cuvsurcv (iip1,j)  = cuvsurcv (1,j)
-       cvsurcuv (iip1,j)  = cvsurcuv (1,j)
-       cuvscvgam1(iip1,j) = cuvscvgam1(1,j)
-       cuvscvgam2(iip1,j) = cuvscvgam2(1,j)
-       cvscuvgam(iip1,j)  = cvscuvgam(1,j)
-      ENDDO
-
-      DO  j     = 2, jjm
-        DO   i  = 1, iim
-        cu(i,j) = 0.5*(cuij1(i,j)+cuij4(i+1,j)+cuij2(i,j)+cuij3(i+1,j))
-        unscu2    (i,j)  = 1./ ( cu(i,j) * cu(i,j) )
-        cvusurcu  (i,j)  =  aireu(i,j) * unscu2(i,j)
-        cusurcvu  (i,j)  = 1./ cvusurcu(i,j)
-        cvuscugam1 (i,j) = cvusurcu(i,j) ** ( - gamdi_gdiv ) 
-        cvuscugam2 (i,j) = cvusurcu(i,j) ** ( - gamdi_h    ) 
-        cuscvugam (i,j)  = cusurcvu(i,j) ** ( - gamdi_grot )
-        ENDDO
-        cu       (iip1,j)  = cu(1,j)
-        unscu2   (iip1,j)  = unscu2(1,j)
-        cvusurcu (iip1,j)  = cvusurcu(1,j)
-        cusurcvu (iip1,j)  = cusurcvu(1,j)
-        cvuscugam1(iip1,j) = cvuscugam1(1,j)
-        cvuscugam2(iip1,j) = cvuscugam2(1,j)
-        cuscvugam (iip1,j) = cuscvugam(1,j)
-      ENDDO
-
-c
-c   ....  calcul aux  poles  ....
-c
-      DO    i      =  1, iip1
-        cu    ( i, 1 )  =   0.
-        unscu2( i, 1 )  =   0.
-        cvu   ( i, 1 )  =   0.
-c
-        cu    (i, jjp1) =   0.
-        unscu2(i, jjp1) =   0.
-        cvu   (i, jjp1) =   0.
-      ENDDO
-c
-c    ..............................................................
-c
-      DO j = 1, jjm
-        DO i= 1, iim
-         airvscu2  (i,j) = airev(i,j)/ ( cuv(i,j) * cuv(i,j) )
-         aivscu2gam(i,j) = airvscu2(i,j)** ( - gamdi_grot )
-        ENDDO
-         airvscu2  (iip1,j)  = airvscu2(1,j)
-         aivscu2gam(iip1,j)  = aivscu2gam(1,j)
-      ENDDO
-
-      DO j=2,jjm
-        DO i=1,iim
-         airuscv2   (i,j)    = aireu(i,j)/ ( cvu(i,j) * cvu(i,j) )
-         aiuscv2gam (i,j)    = airuscv2(i,j)** ( - gamdi_grot ) 
-        ENDDO
-         airuscv2  (iip1,j)  = airuscv2  (1,j)
-         aiuscv2gam(iip1,j)  = aiuscv2gam(1,j)
-      ENDDO
-
-c
-c   calcul des aires aux  poles :
-c   -----------------------------
-c
-      apoln       = SSUM(iim,aire(1,1),1)
-      apols       = SSUM(iim,aire(1,jjp1),1)
-      unsapolnga1 = 1./ ( apoln ** ( - gamdi_gdiv ) )
-      unsapolsga1 = 1./ ( apols ** ( - gamdi_gdiv ) )
-      unsapolnga2 = 1./ ( apoln ** ( - gamdi_h    ) )
-      unsapolsga2 = 1./ ( apols ** ( - gamdi_h    ) )
-c
-c-----------------------------------------------------------------------
-c     gtitre='Coriolis version ancienne'
-c     gfichier='fext1'
-c     CALL writestd(fext,iip1*jjm)
-c
-c   changement F. Hourdin calcul conservatif pour fext
-c   constang contient le produit a * cos ( latitude ) * omega
-c
-      DO i=1,iim
-         constang(i,1) = 0.
-      ENDDO
-      DO j=1,jjm-1
-        DO i=1,iim
-         constang(i,j+1) = rad*omeg*cu(i,j+1)*COS(rlatu(j+1))
-        ENDDO
-      ENDDO
-      DO i=1,iim
-         constang(i,jjp1) = 0.
-      ENDDO
-c
-c   periodicite en longitude
-c
-      DO j=1,jjm
-        fext(iip1,j)     = fext(1,j)
-      ENDDO
-      DO j=1,jjp1
-        constang(iip1,j) = constang(1,j)
-      ENDDO
-
-c fin du changement
-
-c
-c-----------------------------------------------------------------------
-c
-       WRITE(6,*) '   ***  Coordonnees de la grille  *** '
-       WRITE(6,995)
-c
-       WRITE(6,*) '   LONGITUDES  aux pts.   V  ( degres )  '
-       WRITE(6,995)
-        DO i=1,iip1
-         rlonvv(i) = rlonv(i)*180./pi
-        ENDDO
-       WRITE(6,400) rlonvv
-c
-       WRITE(6,995)
-       WRITE(6,*) '   LATITUDES   aux pts.   V  ( degres )  '
-       WRITE(6,995)
-        DO i=1,jjm
-         rlatuu(i)=rlatv(i)*180./pi
-        ENDDO
-       WRITE(6,400) (rlatuu(i),i=1,jjm)
-c
-        DO i=1,iip1
-          rlonvv(i)=rlonu(i)*180./pi
-        ENDDO
-       WRITE(6,995)
-       WRITE(6,*) '   LONGITUDES  aux pts.   U  ( degres )  '
-       WRITE(6,995)
-       WRITE(6,400) rlonvv
-       WRITE(6,995)
-
-       WRITE(6,*) '   LATITUDES   aux pts.   U  ( degres )  '
-       WRITE(6,995)
-        DO i=1,jjp1
-         rlatuu(i)=rlatu(i)*180./pi
-        ENDDO
-       WRITE(6,400) (rlatuu(i),i=1,jjp1)
-       WRITE(6,995)
-c
-444    format(f10.3,f6.0)
-400    FORMAT(1x,8f8.2)
-990    FORMAT(//)
-995    FORMAT(/)
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/inigrads.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/inigrads.F	(revision 1910)
+++ 	(revision )
@@ -1,93 +1,0 @@
-!
-! $Header$
-!
-      subroutine inigrads(if,im
-     s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
-     s  ,dt,file,titlel)
-
-
-      implicit none
-
-      integer if,im,jm,lm,i,j,l
-      real x(im),y(jm),z(lm),fx,fy,fz,dt
-      real xmin,xmax,ymin,ymax
-
-      character(len=*),intent(in) :: file
-      character(len=*),intent(in) :: titlel
-
-#include "gradsdef.h"
-
-c     data unit/66,32,34,36,38,40,42,44,46,48/
-      integer nf
-      save nf
-      data nf/0/
-
-      unit(1)=66
-      unit(2)=32
-      unit(3)=34
-      unit(4)=36
-      unit(5)=38
-      unit(6)=40
-      unit(7)=42
-      unit(8)=44
-      unit(9)=46
-
-      if (if.le.nf) stop'verifier les appels a inigrads'
-
-      print*,'Entree dans inigrads'
-
-      nf=if
-      title(if)=titlel
-      ivar(if)=0
-
-      fichier(if)=trim(file)
-
-      firsttime(if)=.true.
-      dtime(if)=dt
-
-      iid(if)=1
-      ifd(if)=im
-      imd(if)=im
-      do i=1,im
-         xd(i,if)=x(i)*fx
-         if(xd(i,if).lt.xmin) iid(if)=i+1
-         if(xd(i,if).le.xmax) ifd(if)=i
-      enddo
-      print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
-
-      jid(if)=1
-      jfd(if)=jm
-      jmd(if)=jm
-      do j=1,jm
-         yd(j,if)=y(j)*fy
-         if(yd(j,if).gt.ymax) jid(if)=j+1
-         if(yd(j,if).ge.ymin) jfd(if)=j
-      enddo
-      print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
-
-      print*,'Open de dat'
-      print*,'file=',file
-      print*,'fichier(if)=',fichier(if)
-
-      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
-      print*,trim(file)//'.dat'
-
-      OPEN (unit(if)+1,FILE=trim(file)//'.dat'
-     s   ,FORM='unformatted',
-     s   ACCESS='direct'
-     s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
-
-      print*,'Open de dat ok'
-
-      lmd(if)=lm
-      do l=1,lm
-         zd(l,if)=z(l)*fz
-      enddo
-
-      irec(if)=0
-
-      print*,if,imd(if),jmd(if),lmd(if)
-      print*,'if,imd(if),jmd(if),lmd(if)'
-
-      return
-      end
Index: LMDZ5/branches/testing/libf/dyn3dmem/iniprint.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/iniprint.h	(revision 1910)
+++ 	(revision )
@@ -1,11 +1,0 @@
-!
-! $Header$
-!
-!
-! gestion des impressions de sorties et de débogage
-! lunout:    unité du fichier dans lequel se font les sorties 
-!                           (par defaut 6, la sortie standard)
-! prt_level: niveau d'impression souhaité (0 = minimum)
-!
-      INTEGER lunout, prt_level
-      COMMON /comprint/ lunout, prt_level
Index: LMDZ5/branches/testing/libf/dyn3dmem/initial0.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/initial0.F	(revision 1910)
+++ 	(revision )
@@ -1,12 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE initial0(n,x)
-      IMPLICIT NONE
-      INTEGER n,i
-      REAL x(n)
-      DO 10 i=1,n
-         x(i)=0.
-10    CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/inter_barxy_m.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/inter_barxy_m.F90	(revision 1910)
+++ 	(revision )
@@ -1,453 +1,0 @@
-!
-! $Id$
-!
-module inter_barxy_m
-
-  ! Authors: Robert SADOURNY, Phu LE VAN, Lionel GUEZ
-
-  implicit none
-
-  private
-  public inter_barxy
-
-contains
-
-  SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint)
-
-    use assert_eq_m, only: assert_eq
-    use assert_m, only: assert
-
-    include "dimensions.h"
-    ! (for "iim", "jjm")
-
-    include "paramet.h"
-    ! (for other included files)
-
-    include "comgeom2.h"
-    ! (for "aire", "apoln", "apols")
-
-    REAL, intent(in):: dlonid(:)
-    ! (longitude from input file, in rad, from -pi to pi)
-
-    REAL, intent(in):: dlatid(:), champ(:, :), rlonimod(:)
-
-    REAL, intent(in):: rlatimod(:)
-    ! (latitude angle, in degrees or rad, in strictly decreasing order)
-
-    real, intent(out):: champint(:, :)
-    ! Si taille de la seconde dim = jjm + 1, on veut interpoler sur les
-    ! 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 modele (latitudes de V) 
-
-    ! Variables local to the procedure:
-
-    REAL champy(iim, size(champ, 2))
-    integer j, i, jnterfd, jmods
-
-    REAL yjmod(size(champint, 2))
-    ! (angle, in degrees, in strictly increasing order)
-
-    REAL   yjdat(size(dlatid) + 1) ! angle, in degrees, in increasing order
-    LOGICAL decrois ! "dlatid" is in decreasing order
-
-    !-----------------------------------
-
-    jnterfd = assert_eq(size(champ, 2) - 1, size(dlatid), &
-         "inter_barxy jnterfd")
-    jmods = size(champint, 2)
-    call assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)")
-    call assert((/size(rlonimod), size(champint, 1)/) == iim, &
-         "inter_barxy iim")
-    call assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods')
-    call assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)")
-
-    ! Check decreasing order for "rlatimod":
-    DO i = 2, jjm
-       IF (rlatimod(i) >= rlatimod(i-1)) stop &
-            '"inter_barxy": "rlatimod" should be strictly decreasing'
-    ENDDO
-
-    yjmod(:jjm) = ord_coordm(rlatimod)
-    IF (jmods == jjm + 1) THEN
-       IF (90. - yjmod(jjm) < 0.01) stop &
-            '"inter_barxy": with jmods = jjm + 1, yjmod(jjm) should be < 90.'
-    ELSE
-       ! jmods = jjm
-       IF (ABS(yjmod(jjm) - 90.) > 0.01) stop &
-            '"inter_barxy": with jmods = jjm, yjmod(jjm) should be 90.'
-    ENDIF
-
-    if (jmods == jjm + 1) yjmod(jjm + 1) = 90.
-
-    DO j = 1, jnterfd + 1
-       champy(:, j) = inter_barx(dlonid, champ(:, j), rlonimod)
-    ENDDO
-
-    CALL ord_coord(dlatid, yjdat, decrois) 
-    IF (decrois) champy(:, :) = champy(:, jnterfd + 1:1:-1)
-    DO i = 1, iim
-       champint(i, :) = inter_bary(yjdat, champy(i, :), yjmod)
-    ENDDO
-    champint(:, :) = champint(:, jmods:1:-1)
-
-    IF (jmods == jjm + 1) THEN
-       ! Valeurs uniques aux poles
-       champint(:, 1) = SUM(aire(:iim,  1) * champint(:, 1)) / apoln
-       champint(:, jjm + 1) = SUM(aire(:iim, jjm + 1) &
-            * champint(:, jjm + 1)) / apols
-    ENDIF
-
-  END SUBROUTINE inter_barxy
-
-  !******************************
-
-  function inter_barx(dlonid, fdat, rlonimod) 
-
-    !        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
-    !            VERSION UNIDIMENSIONNELLE  ,   EN  LONGITUDE .
-
-    !     idat : indice du champ de donnees, de 1 a idatmax
-    !     imod : indice du champ du modele,  de 1 a  imodmax
-    !     fdat(idat) : champ de donnees (entrees)
-    !     inter_barx(imod) : champ du modele (sorties)
-    !     dlonid(idat): abscisses des interfaces des mailles donnees
-    !     rlonimod(imod): abscisses des interfaces des mailles modele
-    !      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
-    !      ( Les abscisses sont exprimees en degres)
-
-    use assert_eq_m, only: assert_eq
-
-    IMPLICIT NONE
-
-    REAL, intent(in):: dlonid(:)
-    real, intent(in):: fdat(:)
-    real, intent(in):: rlonimod(:)
-
-    real inter_barx(size(rlonimod))
-
-    !    ...  Variables locales ... 
-
-    INTEGER idatmax, imodmax
-    REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)
-    REAL  fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1) 
-    REAL  xxim(size(rlonimod))
-
-    REAL x0, xim0, dx, dxm
-    REAL chmin, chmax, pi
-
-    INTEGER imod, idat, i, ichang, id0, id1, nid, idatmax1
-
-    !-----------------------------------------------------
-
-    idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax")
-    imodmax = size(rlonimod)
-
-    pi = 2. * ASIN(1.)
-
-    !   REDEFINITION DE L'ORIGINE DES ABSCISSES
-    !    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE  
-    DO imod = 1, imodmax
-       xxim(imod) = rlonimod(imod)
-    ENDDO
-
-    CALL minmax( imodmax, xxim, chmin, chmax)
-    IF( chmax.LT.6.50 )   THEN
-       DO imod = 1, imodmax
-          xxim(imod) = xxim(imod) * 180./pi
-       ENDDO
-    ENDIF
-
-    xim0 = xxim(imodmax) - 360.
-
-    DO imod = 1, imodmax
-       xxim(imod) = xxim(imod) - xim0
-    ENDDO
-
-    idatmax1 = idatmax +1
-
-    DO idat = 1, idatmax
-       xxd(idat) = dlonid(idat)
-    ENDDO
-
-    CALL minmax( idatmax, xxd, chmin, chmax)
-    IF( chmax.LT.6.50 )  THEN
-       DO idat = 1, idatmax
-          xxd(idat) = xxd(idat) * 180./pi
-       ENDDO
-    ENDIF
-
-    DO idat = 1, idatmax
-       xxd(idat) = MOD( xxd(idat) - xim0, 360. )
-       fdd(idat) = fdat (idat)
-    ENDDO
-
-    i = 2
-    DO while (xxd(i) >= xxd(i-1) .and. i < idatmax)
-       i = i + 1
-    ENDDO
-    IF (xxd(i) < xxd(i-1)) THEN
-       ichang = i
-       !  ***  reorganisation  des longitudes entre 0. et 360. degres ****
-       nid = idatmax - ichang +1
-       DO i = 1, nid
-          xchan (i) = xxd(i+ichang -1 )
-          fdchan(i) = fdd(i+ichang -1 )
-       ENDDO
-       DO i=1, ichang -1
-          xchan (i+ nid) = xxd(i)
-          fdchan(i+nid) = fdd(i) 
-       ENDDO
-       DO i =1, idatmax
-          xxd(i) = xchan(i)
-          fdd(i) = fdchan(i)
-       ENDDO
-    end IF
-
-    !    translation des champs de donnees par rapport
-    !    a la nouvelle origine, avec redondance de la
-    !       maille a cheval sur les bords
-
-    id0 = 0
-    id1 = 0
-
-    DO idat = 1, idatmax
-       IF ( xxd( idatmax1- idat ).LT.360.) exit
-       id1 = id1 + 1
-    ENDDO
-
-    DO idat = 1, idatmax
-       IF (xxd(idat).GT.0.) exit
-       id0 = id0 + 1
-    END DO
-
-    IF( id1 /= 0 ) then
-       DO idat = 1, id1
-          xxid(idat) = xxd(idatmax - id1 + idat) - 360.
-          fxd (idat) = fdd(idatmax - id1 + idat)     
-       END DO
-       DO idat = 1, idatmax - id1
-          xxid(idat + id1) = xxd(idat)
-          fxd (idat + id1) = fdd(idat)
-       END DO
-    end IF
-
-    IF(id0 /= 0) then
-       DO idat = 1, idatmax - id0
-          xxid(idat) = xxd(idat + id0)
-          fxd (idat) = fdd(idat + id0)
-       END DO
-
-       DO idat = 1, id0
-          xxid (idatmax - id0 + idat) =  xxd(idat) + 360.
-          fxd  (idatmax - id0 + idat) =  fdd(idat)   
-       END DO
-    else 
-       DO idat = 1, idatmax
-          xxid(idat)  = xxd(idat)
-          fxd (idat)  = fdd(idat)
-       ENDDO
-    end IF
-    xxid(idatmax1) = xxid(1) + 360.
-    fxd (idatmax1) = fxd(1)
-
-    !   initialisation du champ du modele
-
-    inter_barx(:) = 0.
-
-    ! iteration
-
-    x0   = xim0
-    dxm  = 0.
-    imod = 1
-    idat = 1
-
-    do while (imod <= imodmax)
-       do while (xxim(imod).GT.xxid(idat))
-          dx   = xxid(idat) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
-          x0   = xxid(idat)
-          idat = idat + 1
-       end do
-       IF (xxim(imod).LT.xxid(idat)) THEN
-          dx   = xxim(imod) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
-          x0   = xxim(imod)
-          dxm  = 0.
-          imod = imod + 1
-       ELSE
-          dx   = xxim(imod) - x0
-          dxm  = dxm + dx
-          inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
-          x0   = xxim(imod)
-          dxm  = 0.
-          imod = imod + 1
-          idat = idat + 1
-       END IF
-    end do
-
-  END function inter_barx
-
-  !******************************
-
-  function inter_bary(yjdat, fdat, yjmod)
-
-    ! Interpolation barycentrique basee sur les aires.
-    ! Version unidimensionnelle, en latitude.
-    ! L'indice 1 correspond a l'interface maille 1 -- maille 2.
-
-    use assert_m, only: assert
-
-    IMPLICIT NONE
-
-    REAL, intent(in):: yjdat(:)
-    ! (angles, ordonnees des interfaces des mailles des donnees, in
-    ! degrees, in increasing order)
-
-    REAL, intent(in):: fdat(:) ! champ de donnees
-
-    REAL, intent(in):: yjmod(:)
-    ! (ordonnees des interfaces des mailles du modele)
-    ! (in degrees, in strictly increasing order)
-
-    REAL inter_bary(size(yjmod)) ! champ du modele
-
-    ! Variables local to the procedure:
-
-    REAL y0, dy, dym 
-    INTEGER jdat ! indice du champ de donnees
-    integer jmod ! indice du champ du modele
-
-    !------------------------------------
-
-    call assert(size(yjdat) == size(fdat), "inter_bary")
-
-    ! Initialisation des variables
-    inter_bary(:) = 0.
-    y0    = -90.
-    dym   = 0.
-    jmod  = 1
-    jdat  = 1
-
-    do while (jmod <= size(yjmod))
-       do while (yjmod(jmod) > yjdat(jdat))
-          dy         = yjdat(jdat) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = inter_bary(jmod) + dy * fdat(jdat)
-          y0         = yjdat(jdat)
-          jdat       = jdat + 1
-       end do
-       IF (yjmod(jmod) < yjdat(jdat)) THEN
-          dy         = yjmod(jmod) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
-          y0         = yjmod(jmod)
-          dym        = 0.
-          jmod       = jmod + 1
-       ELSE
-          ! {yjmod(jmod) == yjdat(jdat)}
-          dy         = yjmod(jmod) - y0
-          dym        = dym + dy
-          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
-          y0         = yjmod(jmod)
-          dym        = 0.
-          jmod       = jmod + 1
-          jdat       = jdat + 1
-       END IF
-    end do
-    ! Le test de fin suppose que l'interface 0 est commune aux deux
-    ! grilles "yjdat" et "yjmod".
-
-  END function inter_bary
-
-  !******************************
-
-  SUBROUTINE ord_coord(xi, xo, decrois)
-
-    ! This procedure receives an array of latitudes.
-    ! It converts them to degrees if they are in radians.
-    ! If the input latitudes are in decreasing order, the procedure
-    ! reverses their order.
-    ! Finally, the procedure adds 90° as the last value of the array.
-
-    use assert_eq_m, only: assert_eq
-
-    IMPLICIT NONE
-
-    include "comconst.h"
-    ! (for "pi")
-
-    REAL, intent(in):: xi(:)
-    ! (latitude, in degrees or radians, in increasing or decreasing order)
-    ! ("xi" should contain latitudes from pole to pole.
-    ! "xi" should contain the latitudes of the boundaries of grid
-    ! cells, not the centers of grid cells.
-    ! So the extreme values should not be 90° and -90°.)
-
-    REAL, intent(out):: xo(:) ! angles in degrees
-    LOGICAL, intent(out):: decrois
-
-    ! Variables  local to the procedure:
-    INTEGER nmax, i
-
-    !--------------------
-
-    nmax = assert_eq(size(xi), size(xo) - 1, "ord_coord")
-
-    ! Check monotonicity:
-    decrois = xi(2) < xi(1)
-    DO i = 3, nmax
-       IF (decrois .neqv. xi(i) < xi(i-1)) stop &
-            '"ord_coord":  latitudes are not monotonic'
-    ENDDO
-
-    IF (abs(xi(1)) < pi) then
-       ! "xi" contains latitudes in radians
-       xo(:nmax) = xi(:) * 180. / pi
-    else
-       ! "xi" contains latitudes in degrees
-       xo(:nmax) = xi(:)
-    end IF
-
-    IF (ABS(abs(xo(1)) - 90) < 0.001 .or. ABS(abs(xo(nmax)) - 90) < 0.001) THEN
-       print *, "ord_coord"
-       PRINT *, '"xi" should contain the latitudes of the boundaries of ' &
-            // 'grid cells, not the centers of grid cells.'
-       STOP
-    ENDIF
-
-    IF (decrois) xo(:nmax) = xo(nmax:1:- 1)
-    xo(nmax + 1) = 90.
-
-  END SUBROUTINE ord_coord
-
-  !***********************************
-
-  function ord_coordm(xi)
-
-    ! This procedure converts to degrees, if necessary, and inverts the
-    ! order.
-
-    IMPLICIT NONE
-
-    include "comconst.h"
-    ! (for "pi")
-
-    REAL, intent(in):: xi(:) ! angle, in rad or degrees
-    REAL ord_coordm(size(xi)) ! angle, in degrees
-
-    !-----------------------------
-
-    IF (xi(1) < 6.5) THEN
-       ! "xi" is in rad
-       ord_coordm(:) = xi(size(xi):1:-1) * 180. / pi
-    else
-       ! "xi" is in degrees
-       ord_coordm(:) = xi(size(xi):1:-1)
-    ENDIF
-
-  END function ord_coordm
-
-end module inter_barxy_m
Index: LMDZ5/branches/testing/libf/dyn3dmem/interpost.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/interpost.F	(revision 1910)
+++ 	(revision )
@@ -1,45 +1,0 @@
-!
-! $Header$
-!
-        subroutine interpost(q,qppm)
-
-       implicit none
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-
-c Arguments   
-      real   q(iip1,jjp1,llm)
-      real   qppm(iim,jjp1,llm)
-c Local
-      integer l,i,j
-  
-c RE-INVERSION DES NIVEAUX
-c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
-c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
-c On passe donc des niveaux de Lin à ceux du LMDZ
-           
-        do l=1,llm
-          do j=1,jjp1
-             do i=1,iim
-                 q(i,j,l)=qppm(i,j,llm-l+1)
-             enddo
-          enddo
-         enddo
-            
-c BOUCLAGE EN LONGITUDE PAS EFFECTUE DANS PPM3D
-
-         do l=1,llm
-           do j=1,jjp1
-            q(iip1,j,l)=q(1,j,l)
-           enddo
-         enddo
-  
-      
-       return
-
-       end
Index: LMDZ5/branches/testing/libf/dyn3dmem/interpre.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/interpre.F	(revision 1910)
+++ 	(revision )
@@ -1,132 +1,0 @@
-!
-! $Id: interpre.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-       subroutine interpre(q,qppm,w,fluxwppm,masse,
-     s            apppm,bpppm,massebx,masseby,pbaru,pbarv,
-     s            unatppm,vnatppm,psppm)
-
-      USE control_mod
-      implicit none
-
-#include "dimensions.h"
-c#include "paramr2.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-#include "ener.h"
-#include "description.h"
-
-c---------------------------------------------------
-c Arguments     
-      real   apppm(llm+1),bpppm(llm+1)
-      real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
-c---------------------------------------------------
-      real   masse(iip1,jjp1,llm) 
-      real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)      
-      real   w(iip1,jjp1,llm+1)
-      real   fluxwppm(iim,jjp1,llm)
-      real   pbaru(iip1,jjp1,llm )
-      real   pbarv(iip1,jjm,llm)
-      real   unatppm(iim,jjp1,llm)
-      real   vnatppm(iim,jjp1,llm)
-      real   psppm(iim,jjp1)
-c---------------------------------------------------
-c Local
-      real   vnat(iip1,jjp1,llm)
-      real   unat(iip1,jjp1,llm)
-      real   fluxw(iip1,jjp1,llm)
-      real   smass(iip1,jjp1)
-c----------------------------------------------------
-      integer l,ij,i,j
-
-c       CALCUL DE LA PRESSION DE SURFACE
-c       Les coefficients ap et bp sont passés en common 
-c       Calcul de la pression au sol en mb optimisée pour 
-c       la vectorialisation
-                   
-         do j=1,jjp1
-             do i=1,iip1
-                smass(i,j)=0.
-             enddo
-         enddo
-
-         do l=1,llm
-             do j=1,jjp1
-                 do i=1,iip1
-                    smass(i,j)=smass(i,j)+masse(i,j,l)
-                 enddo
-             enddo
-         enddo
-      
-         do j=1,jjp1
-             do i=1,iim
-                 psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
-             end do
-         end do                        
-       
-c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
-c Le programme ppm3d travaille avec les composantes
-c de vitesse et pas les flux, on doit donc passer de l'un à l'autre
-c Dans le même temps, on fait le changement d'orientation du vent en v
-      do l=1,llm
-          do j=1,jjm
-              do i=1,iip1
-                  vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)             
-              enddo
-          enddo
-          do  i=1,iim
-          vnat(i,jjp1,l)=0.
-          enddo
-          do j=1,jjp1
-              do i=1,iip1
-                  unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)
-              enddo
-          enddo
-      enddo
-              
-c CALCUL DU FLUX MASSIQUE VERTICAL
-c Flux en l=1 (sol) nul
-      fluxw=0.        
-      do l=1,llm
-           do j=1,jjp1
-              do i=1,iip1              
-               fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
-C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
-C     c                      'w(i,j,l)=',w(i,j,l)
-              enddo
-           enddo
-      enddo
-      
-c INVERSION DES NIVEAUX
-c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
-c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
-c On passe donc des niveaux du LMDZ à ceux de Lin
-     
-      do l=1,llm+1
-          apppm(l)=ap(llm+2-l)
-          bpppm(l)=bp(llm+2-l)         
-      enddo 
-     
-      do l=1,llm
-          do j=1,jjp1
-             do i=1,iim     
-                 unatppm(i,j,l)=unat(i,j,llm-l+1)
-                 vnatppm(i,j,l)=vnat(i,j,llm-l+1)
-                 fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)
-                 qppm(i,j,l)=q(i,j,llm-l+1)                              
-             enddo
-          enddo                                
-      enddo
-   
-      return
-      end
-
-
-
-
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/invert_lat.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/invert_lat.F90	(revision 1910)
+++ 	(revision )
@@ -1,21 +1,0 @@
-
-SUBROUTINE invert_lat(xsize,ysize,vsize,field)
-
-    IMPLICIT NONE
- 
-! Input variables
-    INTEGER, INTENT(IN) :: xsize,ysize,vsize
-    REAL, DIMENSION (xsize,ysize,vsize), INTENT(INOUT) :: field
-! Local variables
-    REAL, DIMENSION (xsize,ysize,vsize)                :: f_aux
-    INTEGER :: l,j
- 
-    DO l=1,vsize
-        DO j=1,ysize
-            f_aux(:,j,l)=field(:,ysize+1-j,l)
-	END DO
-    END DO
-    
-    field=f_aux
-
-    END SUBROUTINE invert_lat
Index: LMDZ5/branches/testing/libf/dyn3dmem/juldate.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/juldate.F	(revision 1910)
+++ 	(revision )
@@ -1,33 +1,0 @@
-!
-! $Header$
-!
-	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
-c	Sous-routine de changement de date:
-c	gregorien>>>date julienne
-c	En entree:an,mois,jour,heure,min.,sec.
-c	En sortie:tjd
-	implicit real (a-h,o-z)
-	frac=((os/60.+om)/60.+oh)/24.
-	ojou=dfloat(ijou)+frac
-	    year=dfloat(ian)
-	    rmon=dfloat(imoi)
-	if (imoi .le. 2) then
-	    year=year-1.
-	    rmon=rmon+12.
-	endif
-	cf=year+(rmon/100.)+(ojou/10000.)
-	if (cf .ge. 1582.1015) then
-	    a=int(year/100)
-	    b=2-a+int(a/4)
-	else
-	    b=0
-	endif
-	tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou)
-     +   +1720994.5+b
-        tjdsec=(ojou-int(ojou))+(tjd-int(tjd))
-        tjd=int(tjd)+int(tjdsec)
-	tjdsec=tjdsec-int(tjdsec)
-	return
-	end
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/laplacien.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/laplacien.F	(revision 1910)
+++ 	(revision )
@@ -1,40 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE laplacien ( 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
-      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 )
-c
-c    ............     variables  locales      ..............
-c
-      REAL ghy(ip1jm,llm), ghx(ip1jmp1,llm)
-c    .......................................................
-
-
-c
-      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
-
-      CALL filtreg( divgra,  jjp1, klevel,  2, 1, .TRUE., 1 )
-      CALL   grad ( klevel,divgra,   ghx , ghy              )
-      CALL  divergf ( klevel, ghx , ghy  , divgra           )
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/laplacien_gam.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/laplacien_gam.F	(revision 1910)
+++ 	(revision )
@@ -1,53 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE laplacien_gam ( 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
-      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    ......................................................
-
-c
-c
-c   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
-c   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
-c   ...  unsairegam =  1. /  aire ** (- gamdissip )
-c
-
-      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
-c
-      CALL   grad ( klevel, divgra, ghx, ghy )
-c
-      CALL  diverg_gam ( klevel, cuvsga, cvusga,  unsaigam  ,
-     *                 unsapolnga, unsapolsga, ghx , ghy , divgra )
-
-c
-
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/laplacien_rot.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/laplacien_rot.F	(revision 1910)
+++ 	(revision )
@@ -1,39 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE laplacien_rot ( 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
-      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
-      CALL  filtreg ( rotin ,   jjm, klevel,   2, 1, .FALSE., 1 )
-
-      CALL   nxgrad ( klevel, rotin,   ghx ,  ghy               )
-      CALL   rotatf  ( klevel, ghx  ,   ghy , rotout             )
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/laplacien_rotgam.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/laplacien_rotgam.F	(revision 1910)
+++ 	(revision )
@@ -1,44 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE laplacien_rotgam ( 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
-      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
-c
-
-      CALL   nxgrad_gam ( klevel, rotin,   ghx ,   ghy  )
-      CALL   rotat_nfil ( klevel, ghx  ,   ghy , rotout )
-c
-      DO l = 1, klevel
-        DO ij = 1, ip1jm
-         rotout(ij,l) = rotout(ij,l) * unsairz_gam(ij)
-        ENDDO
-      ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F	(revision 1999)
@@ -80,17 +80,18 @@
 !      include "mpif.h"
       
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
+      INTEGER,PARAMETER :: longcles = 20
+      REAL,INTENT(IN) :: clesphy0( longcles ) ! not used
+      REAL,INTENT(IN) :: time_0 ! not used
+
+c   dynamical variables:
+      REAL,INTENT(IN) :: ucov0(ijb_u:ije_u,llm)    ! zonal covariant wind
+      REAL,INTENT(IN) :: vcov0(ijb_v:ije_v,llm)    ! meridional covariant wind
+      REAL,INTENT(IN) :: teta0(ijb_u:ije_u,llm)    ! potential temperature
+      REAL,INTENT(IN) :: q0(ijb_u:ije_u,llm,nqtot) ! advected tracers
+      REAL,INTENT(IN) :: ps0(ijb_u:ije_u)          ! surface pressure (Pa)
+      REAL,INTENT(IN) :: masse0(ijb_u:ije_u,llm)   ! air mass
+      REAL,INTENT(IN) :: phis0(ijb_u:ije_u)        ! geopotentiat at the surface
 
       real zqmin,zqmax
-
-c   variables dynamiques
-      REAL :: vcov0(ijb_v:ije_v,llm),ucov0(ijb_u:ije_u,llm) ! vents covariants
-      REAL :: teta0(ijb_u:ije_u,llm)                 ! temperature potentielle 
-      REAL :: q0(ijb_u:ije_u,llm,nqtot)              ! champs advectes
-      REAL :: ps0(ijb_u:ije_u)                       ! pression  au sol
-      REAL :: masse0(ijb_u:ije_u,llm)                ! masse d'air
-      REAL :: phis0(ijb_u:ije_u)                     ! geopotentiel au sol
 
 !      REAL,SAVE,ALLOCATABLE :: p (:,:  )               ! pression aux interfac.des couches
@@ -133,6 +134,5 @@
       REAL       time 
 
-      REAL  SSUM
-      REAL time_0 
+      REAL  SSUM 
 !      REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
 
@@ -670,6 +670,5 @@
       
       IF( forward. OR . leapf )  THEN
- 
- 
+! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
          CALL caladvtrac_loc(q,pbaru,pbarv,
      *        p, masse, dq,  teta,
@@ -680,5 +679,6 @@
 !      enddo
 
-c
+! Ehouarn: Storage of mass flux for off-line tracers... not implemented...
+
       ENDIF ! of IF( forward. OR . leapf )
 
@@ -1140,4 +1140,6 @@
         endif
 c$OMP BARRIER
+        CALL massdair_loc(p,masse)
+c$OMP BARRIER
 
 cc$OMP END PARALLEL
Index: LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_mod.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_mod.F90	(revision 1999)
@@ -1,17 +1,17 @@
 MODULE leapfrog_mod
 
-  REAL,POINTER,SAVE :: ucov(:,:)
-  REAL,POINTER,SAVE :: vcov(:,:)
-  REAL,POINTER,SAVE :: teta(:,:)
-  REAL,POINTER,SAVE :: ps(:)
-  REAL,POINTER,SAVE :: masse(:,:)
-  REAL,POINTER,SAVE :: phis(:)
-  REAL,POINTER,SAVE :: q(:,:,:)
-  REAL,POINTER,SAVE :: p(:,:)
-  REAL,POINTER,SAVE :: pks(:)
-  REAL,POINTER,SAVE :: pk(:,:)
-  REAL,POINTER,SAVE :: pkf(:,:)
-  REAL,POINTER,SAVE :: phi(:,:)
-  REAL,POINTER,SAVE :: w(:,:)
+  REAL,POINTER,SAVE :: ucov(:,:) ! zonal covariant wind
+  REAL,POINTER,SAVE :: vcov(:,:) ! meridional covariant wind
+  REAL,POINTER,SAVE :: teta(:,:) ! potential temperature
+  REAL,POINTER,SAVE :: ps(:) ! surface pressure
+  REAL,POINTER,SAVE :: masse(:,:) ! air mass
+  REAL,POINTER,SAVE :: phis(:) ! geopotential at the surface
+  REAL,POINTER,SAVE :: q(:,:,:) ! advected tracers
+  REAL,POINTER,SAVE :: p(:,:) ! interlayer pressure
+  REAL,POINTER,SAVE :: pks(:) ! Exner at the surface
+  REAL,POINTER,SAVE :: pk(:,:) ! Exner at mid-layer
+  REAL,POINTER,SAVE :: pkf(:,:) ! filtered Exner
+  REAL,POINTER,SAVE :: phi(:,:) ! geopotential
+  REAL,POINTER,SAVE :: w(:,:) ! vertical velocity
   REAL,POINTER,SAVE :: pbaru(:,:)
   REAL,POINTER,SAVE :: pbarv(:,:)
Index: LMDZ5/branches/testing/libf/dyn3dmem/limx.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/limx.F	(revision 1910)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE limx(s0,sx,sm,pente_max)
-c
-c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-c
-c   Arguments:
-c   ----------
-      real pente_max
-      REAL s0(ip1jmp1,llm),sm(ip1jmp1,llm)
-      real sx(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
-      integer n0,iadvplus(ip1jmp1,llm),nl(llm)
-c
-      REAL q(ip1jmp1,llm)
-      real dxq(ip1jmp1,llm)
-
-
-      REAL new_m,zm
-      real dxqu(ip1jmp1)
-      real adxqu(ip1jmp1),dxqmax(ip1jmp1)
-
-      Logical extremum,first
-      save first
-
-      REAL      SSUM,CVMGP,CVMGT
-      integer ismax,ismin
-      EXTERNAL  SSUM, ismin,ismax
-
-      data first/.true./
-
-
-       DO  l = 1,llm
-         DO  ij=1,ip1jmp1
-               q(ij,l) = s0(ij,l) / sm ( ij,l )
-               dxq(ij,l) = sx(ij,l) /sm(ij,l)
-         ENDDO
-       ENDDO
-
-c   calcul de la pente a droite et a gauche de la maille
-
-      do l = 1, llm
-         do ij=iip2,ip1jm-1
-            dxqu(ij)=q(ij+1,l)-q(ij,l)
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            dxqu(ij)=dxqu(ij-iim)
-         enddo
-
-         do ij=iip2,ip1jm
-            adxqu(ij)=abs(dxqu(ij))
-         enddo
-
-c   calcul de la pente maximum dans la maille en valeur absolue
-
-         do ij=iip2+1,ip1jm
-            dxqmax(ij)=pente_max*min(adxqu(ij-1),adxqu(ij))
-         enddo
-
-         do ij=iip1+iip1,ip1jm,iip1
-            dxqmax(ij-iim)=dxqmax(ij)
-         enddo
-
-c   calcul de la pente avec limitation
-
-         do ij=iip2+1,ip1jm
-            if(     dxqu(ij-1)*dxqu(ij).gt.0.
-     &         .and. dxq(ij,l)*dxqu(ij).gt.0.) then
-              dxq(ij,l)=
-     &         sign(min(abs(dxq(ij,l)),dxqmax(ij)),dxq(ij,l))
-            else
-c   extremum local
-               dxq(ij,l)=0.
-            endif
-         enddo
-         do ij=iip1+iip1,ip1jm,iip1
-            dxq(ij-iim,l)=dxq(ij,l)
-         enddo
-
-         DO  ij=1,ip1jmp1
-               sx(ij,l) = dxq(ij,l)*sm(ij,l)
-         ENDDO
-
-       ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/limy.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/limy.F	(revision 1910)
+++ 	(revision )
@@ -1,194 +1,0 @@
-c
-c $Id$
-c
-      SUBROUTINE limy(s0,sy,sm,pente_max)
-c
-c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     q,w sont des arguments d'entree  pour le s-pg ....
-c     dq 	       sont des arguments de sortie pour le s-pg ....
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-c
-c   Arguments:
-c   ----------
-      real pente_max
-      real s0(ip1jmp1,llm),sy(ip1jmp1,llm),sm(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER i,ij,l
-c
-      REAL q(ip1jmp1,llm)
-      REAL airej2,airejjm,airescb(iim),airesch(iim)
-      real sigv,dyq(ip1jmp1),dyqv(ip1jm)
-      real adyqv(ip1jm),dyqmax(ip1jmp1)
-      REAL qbyv(ip1jm,llm)
-
-      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2
-      Logical extremum,first
-      save first
-
-      real convpn,convps,convmpn,convmps
-      real sinlon(iip1),sinlondlon(iip1)
-      real coslon(iip1),coslondlon(iip1)
-      save sinlon,coslon,sinlondlon,coslondlon
-c
-c
-      REAL      SSUM
-      integer ismax,ismin
-      EXTERNAL  SSUM, convflu,ismin,ismax
-      EXTERNAL filtreg
-
-      data first/.true./
-
-      if(first) then
-         print*,'SCHEMA AMONT NOUVEAU'
-         first=.false.
-         do i=2,iip1
-            coslon(i)=cos(rlonv(i))
-            sinlon(i)=sin(rlonv(i))
-            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
-            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
-         enddo
-         coslon(1)=coslon(iip1)
-         coslondlon(1)=coslondlon(iip1)
-         sinlon(1)=sinlon(iip1)
-         sinlondlon(1)=sinlondlon(iip1)
-      endif
-
-c
-
-      do l = 1, llm
-c
-         DO ij=1,ip1jmp1
-               q(ij,l) = s0(ij,l) / sm ( ij,l )
-               dyq(ij) = sy(ij,l) / sm ( ij,l )
-         ENDDO
-c
-c   --------------------------------
-c      CALCUL EN LATITUDE
-c   --------------------------------
-
-c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
-c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
-c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
-
-      airej2 = SSUM( iim, aire(iip2), 1 )
-      airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
-      DO i = 1, iim
-      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
-      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
-      ENDDO
-      qpns   = SSUM( iim,  airescb ,1 ) / airej2
-      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
-
-c   calcul des pentes aux points v
-
-      do ij=1,ip1jm
-         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
-         adyqv(ij)=abs(dyqv(ij))
-      ENDDO
-
-c   calcul des pentes aux points scalaires
-
-      do ij=iip2,ip1jm
-         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
-         dyqmax(ij)=pente_max*dyqmax(ij)
-      enddo
-
-c   calcul des pentes aux poles
-
-c   calcul des pentes limites aux poles
-
-c     print*,dyqv(iip1+1)
-c     appn=abs(dyq(1)/dyqv(iip1+1))
-c     print*,dyq(ip1jm+1)
-c     print*,dyqv(ip1jm-iip1+1)
-c     apps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
-c     do ij=2,iim
-c        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
-c        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
-c     enddo
-c     appn=min(pente_max/appn,1.)
-c     apps=min(pente_max/apps,1.)
-
-
-c   cas ou on a un extremum au pole
-
-c     if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-c    &   appn=0.
-c     if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
-c    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
-c    &   apps=0.
-
-c   limitation des pentes aux poles
-c     do ij=1,iip1
-c        dyq(ij)=appn*dyq(ij)
-c        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
-c     enddo
-
-c   test
-c      do ij=1,iip1
-c         dyq(iip1+ij)=0.
-c         dyq(ip1jm+ij-iip1)=0.
-c      enddo
-c      do ij=1,ip1jmp1
-c         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
-c      enddo
-
-      if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-     &   then
-         do ij=1,iip1
-            dyqmax(ij)=0.
-         enddo
-      else
-         do ij=1,iip1
-            dyqmax(ij)=pente_max*abs(dyqv(ij))
-         enddo
-      endif
-
-      if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
-     & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
-     &then
-         do ij=ip1jm+1,ip1jmp1
-            dyqmax(ij)=0.
-         enddo
-      else
-         do ij=ip1jm+1,ip1jmp1
-            dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
-         enddo
-      endif
-
-c   calcul des pentes limitees
-
-      do ij=1,ip1jmp1
-         if(dyqv(ij)*dyqv(ij-iip1).gt.0.) then
-            dyq(ij)=sign(min(abs(dyq(ij)),dyqmax(ij)),dyq(ij))
-         else
-            dyq(ij)=0.
-         endif
-      enddo
-
-         DO ij=1,ip1jmp1
-               sy(ij,l) = dyq(ij) * sm ( ij,l )
-        ENDDO
-
-      enddo ! fin de la boucle sur les couches verticales
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/limz.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/limz.F	(revision 1910)
+++ 	(revision )
@@ -1,99 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE limz(s0,sz,sm,pente_max)
-c
-c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
-c
-c    ********************************************************************
-c     Shema  d'advection " pseudo amont " .
-c    ********************************************************************
-c     nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
-c
-c
-c   --------------------------------------------------------------------
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "logic.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-c
-c   Arguments:
-c   ----------
-      real pente_max
-      REAL s0(ip1jmp1,llm),sm(ip1jmp1,llm)
-      real sz(ip1jmp1,llm)
-c
-c      Local 
-c   ---------
-c
-      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
-      integer n0,iadvplus(ip1jmp1,llm),nl(llm)
-c
-      REAL q(ip1jmp1,llm)
-      real dzq(ip1jmp1,llm)
-
-
-      REAL new_m,zm
-      real dzqw(ip1jmp1)
-      real adzqw(ip1jmp1),dzqmax(ip1jmp1)
-
-      Logical extremum,first
-      save first
-
-      REAL      SSUM,CVMGP,CVMGT
-      integer ismax,ismin
-      EXTERNAL  SSUM, ismin,ismax
-
-      data first/.true./
-
-
-       DO  l = 1,llm
-         DO  ij=1,ip1jmp1
-               q(ij,l) = s0(ij,l) / sm ( ij,l )
-               dzq(ij,l) = sz(ij,l) /sm(ij,l)
-         ENDDO
-       ENDDO
-
-c   calcul de la pente en haut et en bas de la maille
-       do ij=1,ip1jmp1
-       do l = 1, llm-1
-            dzqw(l)=q(ij,l+1)-q(ij,l)
-         enddo
-            dzqw(llm)=0.
-
-         do  l=1,llm
-            adzqw(l)=abs(dzqw(l))
-         enddo
-
-c   calcul de la pente maximum dans la maille en valeur absolue
-
-         do l=2,llm-1
-            dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l))
-         enddo
-
-c   calcul de la pente avec limitation
-
-         do l=2,llm-1
-            if(     dzqw(l-1)*dzqw(l).gt.0.
-     &         .and. dzq(ij,l)*dzqw(l).gt.0.) then
-              dzq(ij,l)=
-     &         sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))
-            else
-c   extremum local
-               dzq(ij,l)=0.
-            endif
-         enddo
-
-         DO  l=1,llm
-               sz(ij,l) = dzq(ij,l)*sm(ij,l)
-         ENDDO
-
-       ENDDO
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/logic.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/logic.h	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/logic.h	(revision 1999)
@@ -1,4 +1,4 @@
 !
-! $Id$
+! $Id: $
 !
 !
@@ -11,5 +11,5 @@
      &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
      &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
-     &  ,ok_limit,ok_etat0,grilles_gcm_netcdf,hybrid
+     &  ,ok_limit,ok_etat0,hybrid
 
       COMMON/logici/ iflag_phys,iflag_trac
@@ -18,5 +18,6 @@
      & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
      &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
-     &  ,ok_limit,ok_etat0,grilles_gcm_netcdf
+     &  ,ok_limit,ok_etat0
+     
       logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
                      ! (only used if disvert_type==2)
Index: LMDZ5/branches/testing/libf/dyn3dmem/massbar.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/massbar.F	(revision 1910)
+++ 	(revision )
@@ -1,100 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE massbar(  masse, massebx, masseby )
-c
-c **********************************************************************
-c
-c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
-c **********************************************************************
-c    Auteurs : P. Le Van , Fr. Hourdin  .
-c   ..........
-c
-c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
-c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
-c     
-c
-c     IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
-     *      masseby(   ip1jm,llm )
-c
-c
-c   Methode pour calculer massebx et masseby .
-c   ----------------------------------------
-c
-c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
-c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
-c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
-c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
-c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
-c
-c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
-c
-c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
-c
-c
-c
-c   alpha4 .         . alpha1    . alpha4
-c    (i,j)             (i,j)       (i+1,j)
-c
-c             P .        U .          . P
-c           (i,j)       (i,j)         (i+1,j)
-c
-c   alpha3 .         . alpha2    .alpha3 
-c    (i,j)              (i,j)     (i+1,j)
-c
-c             V .        Z .          . V
-c           (i,j)
-c
-c   alpha4 .         . alpha1    .alpha4
-c   (i,j+1)            (i,j+1)   (i+1,j+1) 
-c
-c             P .        U .          . P
-c          (i,j+1)                    (i+1,j+1)
-c
-c
-c
-c                       On  a :
-c
-c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
-c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
-c     localise  au point  ... U (i,j) ...
-c
-c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
-c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
-c     localise  au point  ... V (i,j) ...
-c
-c
-c=======================================================================
-
-      DO   100    l = 1 , llm
-c
-        DO  ij = 1, ip1jmp1 - 1
-         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     + 
-     *                   masse(ij+1, l) * alpha3p4(ij+1 )
-        ENDDO
-
-c    .... correction pour massebx( iip1,j) .....
-c    ...    massebx(iip1,j)= massebx(1,j) ...
-c
-CDIR$ IVDEP
-        DO  ij = iip1, ip1jmp1, iip1
-         massebx( ij,l ) = massebx( ij - iim,l )
-        ENDDO
-
-
-         DO  ij = 1,ip1jm
-         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
-     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
-         ENDDO
-
-100   CONTINUE
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/massbarxy.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/massbarxy.F	(revision 1910)
+++ 	(revision )
@@ -1,47 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE massbarxy(  masse, massebxy )
-c
-c **********************************************************************
-c
-c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
-c **********************************************************************
-c    Auteurs : P. Le Van , Fr. Hourdin  .
-c   ..........
-c
-c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
-c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
-c     
-c
-c     IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
-c
-
-      DO   100    l = 1 , llm
-c
-      DO 5 ij = 1, ip1jm - 1
-      massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    )   +
-     +                   masse(   ij+1 ,l ) * alpha3(  ij+1   )   +
-     +                   masse( ij+iip1,l ) * alpha1( ij+iip1 )   +
-     +                   masse( ij+iip2,l ) * alpha4( ij+iip2 )
-   5  CONTINUE
-
-c    ....  correction pour     massebxy( iip1,j )  ........
-
-CDIR$ IVDEP
-
-      DO 7 ij = iip1, ip1jm, iip1
-      massebxy( ij,l ) = massebxy( ij - iim,l )
-   7  CONTINUE
-
-100   CONTINUE
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/massdair.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/massdair.F	(revision 1910)
+++ 	(revision )
@@ -1,109 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE massdair( p, masse )
-c
-c *********************************************************************
-c       ....  Calcule la masse d'air  dans chaque maille   ....
-c *********************************************************************
-c
-c    Auteurs : P. Le Van , Fr. Hourdin  .
-c   ..........
-c
-c  ..    p                      est  un argum. d'entree pour le s-pg ...
-c  ..  masse                    est un  argum.de sortie pour le s-pg ...
-c     
-c  ....  p est defini aux interfaces des llm couches   .....
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-c  .....   arguments  ....
-c
-      REAL p(ip1jmp1,llmp1), masse(ip1jmp1,llm)
-
-c   ....  Variables locales  .....
-
-      INTEGER l,ij
-      REAL massemoyn, massemoys
-
-      REAL SSUM
-c
-c
-c   Methode pour calculer massebx et masseby .
-c   ----------------------------------------
-c
-c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
-c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
-c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
-c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
-c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
-c
-c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
-c
-c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
-c
-c
-c
-c   alpha4 .         . alpha1    . alpha4
-c    (i,j)             (i,j)       (i+1,j)
-c
-c             P .        U .          . P
-c           (i,j)       (i,j)         (i+1,j)
-c
-c   alpha3 .         . alpha2    .alpha3 
-c    (i,j)              (i,j)     (i+1,j)
-c
-c             V .        Z .          . V
-c           (i,j)
-c
-c   alpha4 .         . alpha1    .alpha4
-c   (i,j+1)            (i,j+1)   (i+1,j+1) 
-c
-c             P .        U .          . P
-c          (i,j+1)                    (i+1,j+1)
-c
-c
-c
-c                       On  a :
-c
-c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
-c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
-c     localise  au point  ... U (i,j) ...
-c
-c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
-c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
-c     localise  au point  ... V (i,j) ...
-c
-c
-c=======================================================================
-
-      DO   100    l = 1 , llm
-c
-        DO    ij     = 1, ip1jmp1
-         masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
-        ENDDO
-c
-        DO   ij = 1, ip1jmp1,iip1
-         masse(ij+ iim,l) = masse(ij,l)
-        ENDDO
-c
-c       DO    ij     = 1,  iim
-c        masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )
-c        masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm) 
-c       ENDDO
-c        massemoyn         = SSUM(iim,masse(   1   ,l),1)/ apoln
-c        massemoys         = SSUM(iim,masse(ip1jm+1,l),1)/ apols
-c       DO    ij     = 1, iip1
-c        masse(   ij   ,l )    = massemoyn
-c        masse(ij+ip1jm,l )    = massemoys
-c       ENDDO
-       
-100   CONTINUE
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/minmax.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/minmax.F	(revision 1910)
+++ 	(revision )
@@ -1,23 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE minmax(imax, xi, zmin, zmax )
-c
-c      P. Le Van
-
-       INTEGER imax
-       REAL    xi(imax)
-       REAL    zmin,zmax
-       INTEGER i
-
-       zmin = xi(1)
-       zmax = xi(1)
-
-       DO i = 2, imax
-         zmin = MIN( zmin,xi(i) )
-         zmax = MAX( zmax,xi(i) )
-       ENDDO
-
-       RETURN
-       END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/minmax2.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/minmax2.F	(revision 1910)
+++ 	(revision )
@@ -1,20 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax )
-c
-       INTEGER lmax,jmax,imax
-       REAL xi(imax*jmax*lmax) 
-       REAL zmin,zmax
-       INTEGER i
-    
-       zmin = xi(1)
-       zmax = xi(1)
-
-       DO i = 2, imax*jmax*lmax
-         zmin = MIN( zmin,xi(i) )
-         zmax = MAX( zmax,xi(i) )
-       ENDDO
-
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/mod_const_mpi.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/mod_const_mpi.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/mod_const_mpi.F90	(revision 1999)
@@ -17,5 +17,8 @@
     USE ioipsl_getincom, only: getin
 #endif
-
+! Use of Oasis-MCT coupler 
+#ifdef CPP_OMCT
+    USE mod_prism
+#endif
     IMPLICIT NONE
 #ifdef CPP_MPI
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgrad.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgrad.F	(revision 1910)
+++ 	(revision )
@@ -1,48 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE nxgrad (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
-      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
-c
-c
-      DO 10 l = 1,klevel
-c
-      DO 1  ij = 2, ip1jm
-      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 = 1, ip1jm, iip1
-      y( ij,l ) = y( ij +iim,l )
-   2  CONTINUE
-c
-      DO 4  ij = iip2,ip1jm
-      x( ij,l ) = (  rot( ij,l ) - rot( ij -iip1,l )  ) * cusurcvu( ij )
-   4  CONTINUE
-      DO 6 ij = 1,iip1
-      x(    ij    ,l ) = 0.
-      x( ij +ip1jm,l ) = 0.
-   6  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgrad_gam.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgrad_gam.F	(revision 1910)
+++ 	(revision )
@@ -1,47 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE nxgrad_gam( 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
-      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
-c
-      DO 10 l = 1,klevel
-c
-      DO 1  ij = 2, ip1jm
-      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 = 1, ip1jm, iip1
-      y( ij,l ) = y( ij +iim,l )
-   2  CONTINUE
-c
-      DO 4  ij = iip2,ip1jm
-      x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
-   4  CONTINUE
-      DO 6 ij = 1,iip1
-      x(    ij    ,l ) = 0.
-      x( ij +ip1jm,l ) = 0.
-   6  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgradst.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgradst.F	(revision 1910)
+++ 	(revision )
@@ -1,47 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE nxgradst (klevel,rot, x, y )
-c
-      IMPLICIT NONE
-c     Auteur :  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
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      INTEGER klevel
-      REAL rot( ip1jm,klevel ),x( ip1jmp1,klevel ),y(ip1jm,klevel )
-      INTEGER l,ij
-c
-      DO 10 l = 1,klevel
-c
-      DO 1  ij = 2, ip1jm
-      y(ij,l)=( rot(ij,l) - rot(ij-1,l))
-   1  CONTINUE
-c
-c    ..... correction pour  y ( 1,j,l )  ......
-c
-c    ....    y(1,j,l)= y(iip1,j,l) ....
-
-      DO 2  ij = 1, ip1jm, iip1
-      y( ij,l ) = y( ij +iim,l )
-   2  CONTINUE
-c
-      DO 4  ij = iip2,ip1jm
-      x(ij,l)= rot(ij,l)-rot(ij-iip1,l)
-   4  CONTINUE
-      DO 6 ij = 1,iip1
-      x(    ij    ,l ) = 0.
-      x( ij +ip1jm,l ) = 0.
-   6  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgraro2.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgraro2.F	(revision 1910)
+++ 	(revision )
@@ -1,68 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
-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
-      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  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
-c
-c    ......   variables locales     ........
-c
-      REAL rot(ip1jm,llm) , signe, nugradrs
-      INTEGER l,ij,iter,lr
-c    ........................................................
-c
-c
-c
-      signe    = (-1.)**lr
-      nugradrs = signe * crot
-c
-      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
-      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
-c
-      CALL     rotatf     ( klevel, grx, gry, rot )
-c
-      CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
-
-c
-c    .....   Iteration de l'operateur laplacien_rotgam  .....
-c
-      DO  iter = 1, lr -2
-        CALL laplacien_rotgam ( klevel, rot, rot )
-      ENDDO
-c
-c
-      CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
-      CALL nxgrad ( klevel, rot, grx, gry )
-c
-      DO    l = 1, klevel
-         DO  ij = 1, ip1jm
-          gry( ij,l ) = gry( ij,l ) * nugradrs
-         ENDDO
-         DO  ij = 1, ip1jmp1
-          grx( ij,l ) = grx( ij,l ) * nugradrs
-         ENDDO
-      ENDDO
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgrarot.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgrarot.F	(revision 1910)
+++ 	(revision )
@@ -1,55 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE nxgrarot (klevel,xcov, ycov, lr, grx, gry )
-c   ***********************************************************
-c
-c    Auteur :  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
-      IMPLICIT NONE
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
-#include "logic.h"
-c
-      INTEGER klevel
-      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
-      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
-c
-      REAL rot(ip1jm,llm)
-
-      INTEGER l,ij,iter,lr
-c
-c
-c
-      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
-      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
-c
-      DO 10 iter = 1,lr
-      CALL  rotat (klevel,grx, gry, rot )
-      CALL filtreg( rot, jjm, klevel, 2,1, .false.,2)
-      CALL nxgrad (klevel,rot, grx, gry )
-c
-      DO 5  l = 1, klevel
-      DO 2 ij = 1, ip1jm
-      gry( ij,l ) = - gry( ij,l ) * crot
-   2  CONTINUE
-      DO 3 ij = 1, ip1jmp1
-      grx( ij,l ) = - grx( ij,l ) * crot
-   3  CONTINUE
-   5  CONTINUE
-c
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/nxgrarot_p.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/nxgrarot_p.F	(revision 1910)
+++ 	(revision )
@@ -1,101 +1,0 @@
-      SUBROUTINE nxgrarot_p (klevel,xcov, ycov, lr, grx_out, gry_out )
-c   ***********************************************************
-c
-c    Auteur :  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 parallel_lmdz
-      USE times
-      USE write_field_p
-      IMPLICIT NONE
-c
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
-#include "logic.h"
-c
-      INTEGER klevel
-      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
-      REAL  grx_out( ip1jmp1,klevel ),  gry_out( ip1jm,klevel )
-      REAL,SAVE ::  grx( ip1jmp1,llm ),  gry( ip1jm,llm )
-
-c
-      REAL,SAVE :: rot(ip1jm,llm)
-
-      INTEGER l,ij,iter,lr
-c
-      INTEGER ijb,ije,jjb,jje
-c
-c
-c      CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
-c      CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
-c
-      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      
-
-      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
-      
-      DO 10 iter = 1,lr
-c$OMP BARRIER
-c$OMP MASTER
-      call suspend_timer(timer_dissip)
-      call exchange_Hallo(grx,ip1jmp1,llm,0,1)
-      call resume_timer(timer_dissip)
-c$OMP END MASTER
-c$OMP BARRIER
-
-      CALL  rotat_p (klevel,grx, gry, rot )
-c      call write_field3d_p('rot',reshape(rot,(/iip1,jjm,llm/)))
-      
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-      CALL filtreg_p( rot,jjb,jje, jjm, klevel, 2,1, .false.,2)
-
-c$OMP BARRIER
-c$OMP MASTER
-      call suspend_timer(timer_dissip)
-      call exchange_Hallo(rot,ip1jm,llm,1,0)
-      call resume_timer(timer_dissip)
-c$OMP END MASTER
-c$OMP BARRIER
-      
-      CALL nxgrad_p (klevel,rot, grx, gry )
-c
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO 5  l = 1, klevel
-      if(pole_sud) ije=ij_end-iip1
-      DO 2 ij = ijb, ije
-      gry_out( ij,l ) = - gry( ij,l ) * crot
-   2  CONTINUE
-      if(pole_sud) ije=ij_end
-      DO 3 ij = ijb, ije
-      grx_out( ij,l ) = - grx( ij,l ) * crot
-   3  CONTINUE
-   5  CONTINUE
-c$OMP END DO NOWAIT
-c      call write_field3d_p('grx',reshape(grx,(/iip1,jjp1,llm/)))
-c      call write_field3d_p('gry',reshape(gry,(/iip1,jjm,llm/)))
-c      stop
-  10  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/parallel_lmdz.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/parallel_lmdz.F90	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/parallel_lmdz.F90	(revision 1999)
@@ -392,5 +392,10 @@
 #endif
 #ifdef CPP_COUPLE
+! Use of Oasis-MCT coupler 
+#if defined CPP_OMCT
+    use mod_prism
+#else
     use mod_prism_proto
+#endif
 ! Ehouarn: surface_data module is in 'phylmd' ...
       use surface_data, only : type_ocean
Index: LMDZ5/branches/testing/libf/dyn3dmem/pbar.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/pbar.F	(revision 1910)
+++ 	(revision )
@@ -1,124 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE pbar ( pext, pbarx, pbary, pbarxy )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c **********************************************************************
-c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
-c *********************************************************************
-c
-c          pext               est  un argum. d'entree  pour le s-pg ..
-c     pbarx,pbary et pbarxy  sont des argum. de sortie pour le s-pg ..
-c
-c   Methode:
-c   --------
-c
-c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
-c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
-c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
-c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
-c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
-c
-c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
-c
-c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
-c
-c
-c
-c   alpha4 .         . alpha1    . alpha4
-c    (i,j)             (i,j)       (i+1,j)
-c
-c             P .        U .          . P
-c           (i,j)       (i,j)         (i+1,j)
-c
-c   alpha3 .         . alpha2    .alpha3 
-c    (i,j)              (i,j)     (i+1,j)
-c
-c             V .        Z .          . V
-c           (i,j)
-c
-c   alpha4 .         . alpha1    .alpha4
-c   (i,j+1)            (i,j+1)   (i+1,j+1) 
-c
-c             P .        U .          . P
-c          (i,j+1)                    (i+1,j+1)
-c
-c
-c
-c
-c                       On  a :
-c
-c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
-c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
-c     localise  au point  ... U (i,j) ...
-c
-c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
-c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
-c     localise  au point  ... V (i,j) ...
-c
-c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
-c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
-c     localise  au point  ... Z (i,j) ...
-c
-c
-c
-c=======================================================================
-
-
-#include "dimensions.h"
-#include "paramet.h"
-
-#include "comgeom.h"
-
-      REAL pext( ip1jmp1 ),  pbarx ( ip1jmp1 )
-      REAL pbary(  ip1jm  ),  pbarxy(  ip1jm  )
-
-      INTEGER   ij
-
-
-
-      DO 1 ij = 1, ip1jmp1 - 1
-      pbarx( ij ) = pext(ij) * alpha1p2(ij) + pext(ij+1)*alpha3p4(ij+1)
-   1  CONTINUE
-
-c    .... correction pour pbarx( iip1,j) .....
-
-c    ...    pbarx(iip1,j)= pbarx(1,j) ...
-CDIR$ IVDEP
-      DO 2 ij = iip1, ip1jmp1, iip1
-      pbarx( ij ) = pbarx( ij - iim )
-   2  CONTINUE
-
-
-      DO 3 ij = 1,ip1jm
-      pbary( ij ) = pext(   ij  )   * alpha2p3(   ij   )     +
-     *              pext( ij+iip1 ) * alpha1p4( ij+iip1 )
-   3  CONTINUE
-
-
-      DO 5 ij = 1, ip1jm - 1
-      pbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
-     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
-   5  CONTINUE
-
-
-c    ....  correction pour     pbarxy( iip1,j )  ........
-
-CDIR$ IVDEP
-
-      DO 7 ij = iip1, ip1jm, iip1
-      pbarxy( ij ) = pbarxy( ij - iim )
-   7  CONTINUE
-
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/pentes_ini.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/pentes_ini.F	(revision 1910)
+++ 	(revision )
@@ -1,474 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE pentes_ini (q,w,masse,pbaru,pbarv,mode)
-      IMPLICIT NONE
-
-c=======================================================================
-c   Adaptation LMDZ:  A.Armengaud (LGGE)
-c   ----------------
-c
-c   ********************************************************************
-c   Transport des traceurs par la methode des pentes
-c   ********************************************************************
-c   Reference possible : Russel. G.L., Lerner J.A.:
-c         A new Finite-Differencing Scheme for Traceur Transport 
-c         Equation , Journal of Applied Meteorology, pp 1483-1498,dec. 81 
-c   ********************************************************************
-c   q,w,masse,pbaru et pbarv 
-c                      sont des arguments d'entree  pour le s-pg ....
-c
-c=======================================================================
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-
-c   Arguments:
-c   ----------
-      integer mode
-      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm )
-      REAL q( iip1,jjp1,llm,0:3)
-      REAL w( ip1jmp1,llm )
-      REAL masse( iip1,jjp1,llm)
-c   Local:
-c   ------
-      LOGICAL limit
-      REAL sm ( iip1,jjp1, llm )
-      REAL s0( iip1,jjp1,llm ),  sx( iip1,jjp1,llm )
-      REAL sy( iip1,jjp1,llm ),  sz( iip1,jjp1,llm )
-      real masn,mass,zz
-      INTEGER i,j,l,iq
-
-c  modif Fred 24 03 96
-
-      real sinlon(iip1),sinlondlon(iip1)
-      real coslon(iip1),coslondlon(iip1)
-      save sinlon,coslon,sinlondlon,coslondlon
-      real dyn1,dyn2,dys1,dys2
-      real qpn,qps,dqzpn,dqzps
-      real smn,sms,s0n,s0s,sxn(iip1),sxs(iip1)
-      real qmin,zq,pente_max
-c
-      REAL      SSUM
-      integer ismax,ismin,lati,latf
-      EXTERNAL  SSUM, ismin,ismax
-      logical first
-      save first
-c   fin modif
-
-
-c  modif Fred 24 03 96
-      data first/.true./
-
-      limit = .TRUE.
-      pente_max=2
-c     if (mode.eq.1.or.mode.eq.3) then
-c     if (mode.eq.1) then
-      if (mode.ge.1) then
-        lati=2
-        latf=jjm
-      else
-        lati=1
-        latf=jjp1
-      endif
-
-      qmin=0.4995
-      qmin=0.
-      if(first) then
-         print*,'SCHEMA AMONT NOUVEAU'
-         first=.false.
-         do i=2,iip1
-            coslon(i)=cos(rlonv(i))
-            sinlon(i)=sin(rlonv(i))
-            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
-            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
-            print*,coslondlon(i),sinlondlon(i)
-         enddo
-         coslon(1)=coslon(iip1)
-         coslondlon(1)=coslondlon(iip1)
-         sinlon(1)=sinlon(iip1)
-         sinlondlon(1)=sinlondlon(iip1)
-         print*,'sum sinlondlon ',ssum(iim,sinlondlon,1)/sinlondlon(1)
-         print*,'sum coslondlon ',ssum(iim,coslondlon,1)/coslondlon(1)
-        DO l = 1,llm
-        DO j = 1,jjp1
-         DO i = 1,iip1
-         q ( i,j,l,1 )=0.
-         q ( i,j,l,2 )=0.
-         q ( i,j,l,3 )=0.  
-         ENDDO
-         ENDDO
-        ENDDO
-        
-      endif
-c   Fin modif Fred
-
-c *** q contient les qqtes de traceur avant l'advection 
-
-c *** Affectation des tableaux S a partir de Q
-c *** Rem : utilisation de SCOPY ulterieurement
- 
-       DO l = 1,llm
-        DO j = 1,jjp1
-         DO i = 1,iip1
-             s0( i,j,llm+1-l ) = q ( i,j,l,0 )
-             sx( i,j,llm+1-l ) = q ( i,j,l,1 )
-             sy( i,j,llm+1-l ) = q ( i,j,l,2 )
-             sz( i,j,llm+1-l ) = q ( i,j,l,3 )
-         ENDDO
-        ENDDO
-       ENDDO
-
-c      PRINT*,'----- S0 just before conversion -------'
-c      PRINT*,'S0(16,12,1)=',s0(16,12,1) 
-c      PRINT*,'Q(16,12,1,4)=',q(16,12,1,4)
-
-c *** On calcule la masse d'air en kg
-
-       DO  l = 1,llm
-         DO  j = 1,jjp1
-           DO  i = 1,iip1
-            sm ( i,j,llm+1-l)=masse( i,j,l )
-          ENDDO
-         ENDDO
-       ENDDO
-
-c *** On converti les champs S en atome (resp. kg) 
-c *** Les routines d'advection traitent les champs
-c *** a advecter si ces derniers sont en atome (resp. kg)
-c *** A optimiser !!!
-
-       DO  l = 1,llm
-         DO  j = 1,jjp1
-           DO  i = 1,iip1
-               s0(i,j,l) = s0(i,j,l) * sm ( i,j,l )
-               sx(i,j,l) = sx(i,j,l) * sm ( i,j,l )
-               sy(i,j,l) = sy(i,j,l) * sm ( i,j,l )
-               sz(i,j,l) = sz(i,j,l) * sm ( i,j,l )
-           ENDDO
-         ENDDO
-       ENDDO
-
-c       ss0 = 0.
-c       DO l = 1,llm
-c        DO j = 1,jjp1
-c         DO i = 1,iim
-c            ss0 = ss0 + s0 ( i,j,l )
-c         ENDDO
-c        ENDDO
-c       ENDDO
-c       PRINT*, 'valeur tot s0 avant advection=',ss0
-
-c *** Appel des subroutines d'advection en X, en Y et en Z
-c *** Advection avec "time-splitting"
-      
-c-----------------------------------------------------------
-c      PRINT*,'----- S0 just before ADVX -------'
-c      PRINT*,'S0(16,12,1)=',s0(16,12,1)
-
-c-----------------------------------------------------------
-c      do l=1,llm
-c         do j=1,jjp1
-c          do i=1,iip1
-c             zq=s0(i,j,l)/sm(i,j,l)
-c            if(zq.lt.qmin)
-c    ,       print*,'avant advx1, s0(',i,',',j,',',l,')=',zq
-c          enddo
-c         enddo
-c      enddo
-CCC
-       if(mode.eq.2) then
-          do l=1,llm
-            s0s=0.
-            s0n=0.
-            dyn1=0.
-            dys1=0.
-            dyn2=0.
-            dys2=0.
-            smn=0.
-            sms=0.
-            do i=1,iim
-               smn=smn+sm(i,1,l)
-               sms=sms+sm(i,jjp1,l)
-               s0n=s0n+s0(i,1,l)
-               s0s=s0s+s0(i,jjp1,l)
-               zz=sy(i,1,l)/sm(i,1,l)
-               dyn1=dyn1+sinlondlon(i)*zz
-               dyn2=dyn2+coslondlon(i)*zz
-               zz=sy(i,jjp1,l)/sm(i,jjp1,l)
-               dys1=dys1+sinlondlon(i)*zz
-               dys2=dys2+coslondlon(i)*zz
-            enddo
-            do i=1,iim
-               sy(i,1,l)=dyn1*sinlon(i)+dyn2*coslon(i)
-               sy(i,jjp1,l)=dys1*sinlon(i)+dys2*coslon(i)
-            enddo
-            do i=1,iim
-               s0(i,1,l)=s0n/smn+sy(i,1,l)
-               s0(i,jjp1,l)=s0s/sms-sy(i,jjp1,l)
-            enddo
-
-            s0(iip1,1,l)=s0(1,1,l)
-            s0(iip1,jjp1,l)=s0(1,jjp1,l)
-
-            do i=1,iim
-               sxn(i)=s0(i+1,1,l)-s0(i,1,l)
-               sxs(i)=s0(i+1,jjp1,l)-s0(i,jjp1,l)
-c   on rerentre les masses
-            enddo
-            do i=1,iim
-               sy(i,1,l)=sy(i,1,l)*sm(i,1,l)
-               sy(i,jjp1,l)=sy(i,jjp1,l)*sm(i,jjp1,l)
-               s0(i,1,l)=s0(i,1,l)*sm(i,1,l)
-               s0(i,jjp1,l)=s0(i,jjp1,l)*sm(i,jjp1,l)
-            enddo
-            sxn(iip1)=sxn(1)
-            sxs(iip1)=sxs(1)
-            do i=1,iim
-               sx(i+1,1,l)=0.25*(sxn(i)+sxn(i+1))*sm(i+1,1,l)
-               sx(i+1,jjp1,l)=0.25*(sxs(i)+sxs(i+1))*sm(i+1,jjp1,l)
-            enddo
-            s0(iip1,1,l)=s0(1,1,l)
-            s0(iip1,jjp1,l)=s0(1,jjp1,l)
-            sy(iip1,1,l)=sy(1,1,l)
-            sy(iip1,jjp1,l)=sy(1,jjp1,l)
-            sx(1,1,l)=sx(iip1,1,l)
-            sx(1,jjp1,l)=sx(iip1,jjp1,l)
-          enddo
-      endif
-
-      if (mode.eq.4) then
-         do l=1,llm
-            do i=1,iip1
-               sx(i,1,l)=0.
-               sx(i,jjp1,l)=0.
-               sy(i,1,l)=0.
-               sy(i,jjp1,l)=0.
-            enddo
-         enddo
-      endif
-      call limx(s0,sx,sm,pente_max)
-c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')
-       call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
-c     call minmaxq(zq,1.e33,-1.e33,'avant advy     ')
-      if (mode.eq.4) then
-         do l=1,llm
-            do i=1,iip1
-               sx(i,1,l)=0.
-               sx(i,jjp1,l)=0.
-               sy(i,1,l)=0.
-               sy(i,jjp1,l)=0.
-            enddo
-         enddo
-      endif
-       call   limy(s0,sy,sm,pente_max)
-       call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz ) 
-c     call minmaxq(zq,1.e33,-1.e33,'avant advz     ')
-       do j=1,jjp1
-          do i=1,iip1
-             sz(i,j,1)=0.
-             sz(i,j,llm)=0.
-          enddo
-       enddo
-       call limz(s0,sz,sm,pente_max)
-       call advz( limit,dtvr,w,sm,s0,sx,sy,sz )
-      if (mode.eq.4) then
-         do l=1,llm
-            do i=1,iip1
-               sx(i,1,l)=0.
-               sx(i,jjp1,l)=0.
-               sy(i,1,l)=0.
-               sy(i,jjp1,l)=0.
-            enddo
-         enddo
-      endif
-        call limy(s0,sy,sm,pente_max)
-       call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz ) 
-       do l=1,llm
-          do j=1,jjp1
-             sm(iip1,j,l)=sm(1,j,l)
-             s0(iip1,j,l)=s0(1,j,l)
-             sx(iip1,j,l)=sx(1,j,l)
-             sy(iip1,j,l)=sy(1,j,l)
-             sz(iip1,j,l)=sz(1,j,l)
-          enddo
-       enddo
-
-
-c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')
-      if (mode.eq.4) then
-         do l=1,llm
-            do i=1,iip1
-               sx(i,1,l)=0.
-               sx(i,jjp1,l)=0.
-               sy(i,1,l)=0.
-               sy(i,jjp1,l)=0.
-            enddo
-         enddo
-      endif
-       call limx(s0,sx,sm,pente_max)
-       call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf) 
-c     call minmaxq(zq,1.e33,-1.e33,'apres advx     ')
-c      do l=1,llm
-c         do j=1,jjp1
-c          do i=1,iip1
-c             zq=s0(i,j,l)/sm(i,j,l)
-c            if(zq.lt.qmin)
-c    ,       print*,'apres advx2, s0(',i,',',j,',',l,')=',zq
-c          enddo
-c         enddo
-c      enddo
-c ***   On repasse les S dans la variable q directement 14/10/94
-c   On revient a des rapports de melange en divisant par la masse
-
-c En dehors des poles:
-
-       DO  l = 1,llm
-        DO  j = 1,jjp1
-         DO  i = 1,iim
-             q(i,j,llm+1-l,0)=s0(i,j,l)/sm(i,j,l)
-             q(i,j,llm+1-l,1)=sx(i,j,l)/sm(i,j,l)
-             q(i,j,llm+1-l,2)=sy(i,j,l)/sm(i,j,l)
-             q(i,j,llm+1-l,3)=sz(i,j,l)/sm(i,j,l)
-         ENDDO
-        ENDDO
-      ENDDO
-
-c Traitements specifiques au pole
-
-      if(mode.ge.1) then
-      DO l=1,llm
-c   filtrages aux poles
-         masn=ssum(iim,sm(1,1,l),1)
-         mass=ssum(iim,sm(1,jjp1,l),1)
-         qpn=ssum(iim,s0(1,1,l),1)/masn
-         qps=ssum(iim,s0(1,jjp1,l),1)/mass
-         dqzpn=ssum(iim,sz(1,1,l),1)/masn
-         dqzps=ssum(iim,sz(1,jjp1,l),1)/mass
-         do i=1,iip1
-            q( i,1,llm+1-l,3)=dqzpn
-            q( i,jjp1,llm+1-l,3)=dqzps
-            q( i,1,llm+1-l,0)=qpn
-            q( i,jjp1,llm+1-l,0)=qps
-         enddo
-         if(mode.eq.3) then
-            dyn1=0.
-            dys1=0.
-            dyn2=0.
-            dys2=0.
-            do i=1,iim
-               dyn1=dyn1+sinlondlon(i)*sy(i,1,l)/sm(i,1,l)
-               dyn2=dyn2+coslondlon(i)*sy(i,1,l)/sm(i,1,l)
-               dys1=dys1+sinlondlon(i)*sy(i,jjp1,l)/sm(i,jjp1,l)
-               dys2=dys2+coslondlon(i)*sy(i,jjp1,l)/sm(i,jjp1,l)
-            enddo
-            do i=1,iim
-               q(i,1,llm+1-l,2)=
-     s          (sinlon(i)*dyn1+coslon(i)*dyn2)
-               q(i,1,llm+1-l,0)=q(i,1,llm+1-l,0)+q(i,1,llm+1-l,2)
-               q(i,jjp1,llm+1-l,2)=
-     s          (sinlon(i)*dys1+coslon(i)*dys2)
-               q(i,jjp1,llm+1-l,0)=q(i,jjp1,llm+1-l,0)
-     s         -q(i,jjp1,llm+1-l,2)
-            enddo
-         endif
-         if(mode.eq.1) then
-c   on filtre les valeurs au bord de la "grande maille pole"
-            dyn1=0.
-            dys1=0.
-            dyn2=0.
-            dys2=0.
-            do i=1,iim
-               zz=s0(i,2,l)/sm(i,2,l)-q(i,1,llm+1-l,0)
-               dyn1=dyn1+sinlondlon(i)*zz
-               dyn2=dyn2+coslondlon(i)*zz
-               zz=q(i,jjp1,llm+1-l,0)-s0(i,jjm,l)/sm(i,jjm,l)
-               dys1=dys1+sinlondlon(i)*zz
-               dys2=dys2+coslondlon(i)*zz
-            enddo
-            do i=1,iim
-               q(i,1,llm+1-l,2)=
-     s          (sinlon(i)*dyn1+coslon(i)*dyn2)/2.
-               q(i,1,llm+1-l,0)=q(i,1,llm+1-l,0)+q(i,1,llm+1-l,2)
-               q(i,jjp1,llm+1-l,2)=
-     s          (sinlon(i)*dys1+coslon(i)*dys2)/2.
-               q(i,jjp1,llm+1-l,0)=q(i,jjp1,llm+1-l,0)
-     s         -q(i,jjp1,llm+1-l,2)
-            enddo
-            q(iip1,1,llm+1-l,0)=q(1,1,llm+1-l,0)
-            q(iip1,jjp1,llm+1-l,0)=q(1,jjp1,llm+1-l,0)
-
-            do i=1,iim
-               sxn(i)=q(i+1,1,llm+1-l,0)-q(i,1,llm+1-l,0)
-               sxs(i)=q(i+1,jjp1,llm+1-l,0)-q(i,jjp1,llm+1-l,0)
-            enddo
-            sxn(iip1)=sxn(1)
-            sxs(iip1)=sxs(1)
-            do i=1,iim
-               q(i+1,1,llm+1-l,1)=0.25*(sxn(i)+sxn(i+1))
-               q(i+1,jjp1,llm+1-l,1)=0.25*(sxs(i)+sxs(i+1))
-            enddo
-            q(1,1,llm+1-l,1)=q(iip1,1,llm+1-l,1)
-            q(1,jjp1,llm+1-l,1)=q(iip1,jjp1,llm+1-l,1)
-
-         endif
-
-       ENDDO
-       endif
-
-c bouclage en longitude
-      do iq=0,3
-         do l=1,llm
-            do j=1,jjp1
-               q(iip1,j,l,iq)=q(1,j,l,iq)
-            enddo
-         enddo
-      enddo
-
-c       PRINT*, ' SORTIE DE PENTES ---  ca peut glisser ....'
-
-        DO l = 1,llm
-    	 DO j = 1,jjp1
-    	  DO i = 1,iip1
-                IF (q(i,j,l,0).lt.0.)  THEN
-c                    PRINT*,'------------ BIP-----------' 
-c                    PRINT*,'Q0(',i,j,l,')=',q(i,j,l,0)
-c                    PRINT*,'QX(',i,j,l,')=',q(i,j,l,1)
-c                    PRINT*,'QY(',i,j,l,')=',q(i,j,l,2)
-c                    PRINT*,'QZ(',i,j,l,')=',q(i,j,l,3)
-c       		     PRINT*,' PBL EN SORTIE DE PENTES'
-                     q(i,j,l,0)=0.
-c                    STOP
-                 ENDIF
-          ENDDO
-         ENDDO
-        ENDDO
-
-c       PRINT*, '-------------------------------------------'
-        
-       do l=1,llm
-          do j=1,jjp1
-           do i=1,iip1
-             if(q(i,j,l,0).lt.qmin)
-     ,       print*,'apres pentes, s0(',i,',',j,',',l,')=',q(i,j,l,0)
-           enddo
-          enddo
-       enddo
-      RETURN
-      END
-
-
-
-
-
-
-
-
-
-
-
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/ppm3d.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ppm3d.F	(revision 1910)
+++ 	(revision )
@@ -1,2001 +1,0 @@
-!
-! $Id: ppm3d.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-
-cFrom lin@explorer.gsfc.nasa.gov Wed Apr 15 17:44:44 1998
-cDate: Wed, 15 Apr 1998 11:37:03 -0400
-cFrom: lin@explorer.gsfc.nasa.gov
-cTo: Frederic.Hourdin@lmd.jussieu.fr
-cSubject: 3D transport module of the GSFC CTM and GEOS GCM
-
-
-cThis code is sent to you by S-J Lin, DAO, NASA-GSFC
-
-cNote: this version is intended for machines like CRAY
-C-90. No multitasking directives implemented.
-
-      
-C ********************************************************************
-C
-C TransPort Core for Goddard Chemistry Transport Model (G-CTM), Goddard
-C Earth Observing System General Circulation Model (GEOS-GCM), and Data
-C Assimilation System (GEOS-DAS).
-C
-C ********************************************************************
-C
-C Purpose: given horizontal winds on  a hybrid sigma-p surfaces,
-C          one call to tpcore updates the 3-D mixing ratio
-C          fields one time step (NDT). [vertical mass flux is computed
-C          internally consistent with the discretized hydrostatic mass
-C          continuity equation of the C-Grid GEOS-GCM (for IGD=1)].
-C
-C Schemes: Multi-dimensional Flux Form Semi-Lagrangian (FFSL) scheme based
-C          on the van Leer or PPM.
-C          (see Lin and Rood 1996).
-C Version 4.5
-C Last modified: Dec. 5, 1996
-C Major changes from version 4.0: a more general vertical hybrid sigma-
-C pressure coordinate.
-C Subroutines modified: xtp, ytp, fzppm, qckxyz
-C Subroutines deleted: vanz
-C
-C Author: Shian-Jiann Lin
-C mail address:
-C                 Shian-Jiann Lin*
-C                 Code 910.3, NASA/GSFC, Greenbelt, MD 20771
-C                 Phone: 301-286-9540
-C                 E-mail: lin@dao.gsfc.nasa.gov
-C
-C *affiliation:
-C                 Joint Center for Earth Systems Technology
-C                 The University of Maryland Baltimore County
-C                 NASA - Goddard Space Flight Center
-C References:
-C
-C 1. Lin, S.-J., and R. B. Rood, 1996: Multidimensional flux form semi-
-C    Lagrangian transport schemes. Mon. Wea. Rev., 124, 2046-2070.
-C
-C 2. Lin, S.-J., W. C. Chao, Y. C. Sud, and G. K. Walker, 1994: A class of
-C    the van Leer-type transport schemes and its applications to the moist-
-C    ure transport in a General Circulation Model. Mon. Wea. Rev., 122,
-C    1575-1593.
-C
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-      subroutine ppm3d(IGD,Q,PS1,PS2,U,V,W,NDT,IORD,JORD,KORD,NC,IMR,
-     &                  JNP,j1,NLAY,AP,BP,PT,AE,fill,dum,Umax)
-
-c      implicit none
-
-c     rajout de déclarations
-c      integer Jmax,kmax,ndt0,nstep,k,j,i,ic,l,js,jn,imh,iad,jad,krd
-c      integer iu,iiu,j2,jmr,js0,jt
-c      real dtdy,dtdy5,rcap,iml,jn0,imjm,pi,dl,dp
-c      real dt,cr1,maxdt,ztc,d5,sum1,sum2,ru
-C
-C ********************************************************************
-C
-C =============
-C INPUT:
-C =============
-C
-C Q(IMR,JNP,NLAY,NC): mixing ratios at current time (t)
-C NC: total # of constituents
-C IMR: first dimension (E-W); # of Grid intervals in E-W is IMR
-C JNP: 2nd dimension (N-S); # of Grid intervals in N-S is JNP-1
-C NLAY: 3rd dimension (# of layers); vertical index increases from 1 at
-C       the model top to NLAY near the surface (see fig. below).
-C       It is assumed that 6 <= NLAY <= JNP (for dynamic memory allocation)
-C
-C PS1(IMR,JNP): surface pressure at current time (t)
-C PS2(IMR,JNP): surface pressure at mid-time-level (t+NDT/2)
-C PS2 is replaced by the predicted PS (at t+NDT) on output.
-C Note: surface pressure can have any unit or can be multiplied by any
-C       const.
-C
-C The pressure at layer edges are defined as follows:
-C
-C        p(i,j,k) = AP(k)*PT  +  BP(k)*PS(i,j)          (1)
-C
-C Where PT is a constant having the same unit as PS.
-C AP and BP are unitless constants given at layer edges
-C defining the vertical coordinate. 
-C BP(1) = 0., BP(NLAY+1) = 1.
-C The pressure at the model top is PTOP = AP(1)*PT
-C
-C For pure sigma system set AP(k) = 1 for all k, PT = PTOP,
-C BP(k) = sige(k) (sigma at edges), PS = Psfc - PTOP.
-C
-C Note: the sigma-P coordinate is a subset of Eq. 1, which in turn
-C is a subset of the following even more general sigma-P-thelta coord.
-C currently under development.
-C  p(i,j,k) = (AP(k)*PT + BP(k)*PS(i,j))/(D(k)-C(k)*TE**(-1/kapa))
-C
-C                  /////////////////////////////////
-C              / \ ------------- PTOP --------------  AP(1), BP(1)
-C               |
-C    delp(1)    |  ........... Q(i,j,1) ............  
-C               |
-C      W(1)    \ / ---------------------------------  AP(2), BP(2)
-C
-C
-C
-C     W(k-1)   / \ ---------------------------------  AP(k), BP(k)
-C               |
-C    delp(K)    |  ........... Q(i,j,k) ............ 
-C               |
-C      W(k)    \ / ---------------------------------  AP(k+1), BP(k+1)
-C
-C
-C
-C              / \ ---------------------------------  AP(NLAY), BP(NLAY)
-C               |
-C  delp(NLAY)   |  ........... Q(i,j,NLAY) .........  
-C               |
-C   W(NLAY)=0  \ / ------------- surface ----------- AP(NLAY+1), BP(NLAY+1)
-C                 //////////////////////////////////
-C
-C U(IMR,JNP,NLAY) & V(IMR,JNP,NLAY):winds (m/s) at mid-time-level (t+NDT/2)
-C U and V may need to be polar filtered in advance in some cases.
-C 
-C IGD:      grid type on which winds are defined.
-C IGD = 0:  A-Grid  [all variables defined at the same point from south
-C                   pole (j=1) to north pole (j=JNP) ]
-C
-C IGD = 1  GEOS-GCM C-Grid
-C                                      [North]
-C
-C                                       V(i,j)
-C                                          |
-C                                          |
-C                                          |
-C                             U(i-1,j)---Q(i,j)---U(i,j) [EAST]
-C                                          |
-C                                          |
-C                                          |
-C                                       V(i,j-1)
-C
-C         U(i,  1) is defined at South Pole.
-C         V(i,  1) is half grid north of the South Pole.
-C         V(i,JMR) is half grid south of the North Pole.
-C
-C         V must be defined at j=1 and j=JMR if IGD=1
-C         V at JNP need not be given.
-C
-C NDT: time step in seconds (need not be constant during the course of
-C      the integration). Suggested value: 30 min. for 4x5, 15 min. for 2x2.5
-C      (Lat-Lon) resolution. Smaller values are recommanded if the model
-C      has a well-resolved stratosphere.
-C
-C J1 defines the size of the polar cap:
-C South polar cap edge is located at -90 + (j1-1.5)*180/(JNP-1) deg.
-C North polar cap edge is located at  90 - (j1-1.5)*180/(JNP-1) deg.
-C There are currently only two choices (j1=2 or 3).
-C IMR must be an even integer if j1 = 2. Recommended value: J1=3.
-C
-C IORD, JORD, and KORD are integers controlling various options in E-W, N-S,
-C and vertical transport, respectively. Recommended values for positive
-C definite scalars: IORD=JORD=3, KORD=5. Use KORD=3 for non-
-C positive definite scalars or when linear correlation between constituents
-C is to be maintained.
-C
-C  _ORD= 
-C        1: 1st order upstream scheme (too diffusive, not a useful option; it
-C           can be used for debugging purposes; this is THE only known "linear"
-C           monotonic advection scheme.).
-C        2: 2nd order van Leer (full monotonicity constraint;
-C           see Lin et al 1994, MWR)
-C        3: monotonic PPM* (slightly improved PPM of Collela & Woodward 1984)
-C        4: semi-monotonic PPM (same as 3, but overshoots are allowed)
-C        5: positive-definite PPM (constraint on the subgrid distribution is
-C           only strong enough to prevent generation of negative values;
-C           both overshoots & undershoots are possible).
-C        6: un-constrained PPM (nearly diffusion free; slightly faster but
-C           positivity not quaranteed. Use this option only when the fields
-C           and winds are very smooth).
-C
-C *PPM: Piece-wise Parabolic Method
-C
-C Note that KORD <=2 options are no longer supported. DO not use option 4 or 5.
-C for non-positive definite scalars (such as Ertel Potential Vorticity).
-C
-C The implicit numerical diffusion decreases as _ORD increases.
-C The last two options (ORDER=5, 6) should only be used when there is
-C significant explicit diffusion (such as a turbulence parameterization). You
-C might get dispersive results otherwise.
-C No filter of any kind is applied to the constituent fields here.
-C
-C AE: Radius of the sphere (meters).
-C     Recommended value for the planet earth: 6.371E6
-C
-C fill(logical):   flag to do filling for negatives (see note below).
-C
-C Umax: Estimate (upper limit) of the maximum U-wind speed (m/s).
-C (220 m/s is a good value for troposphere model; 280 m/s otherwise)
-C
-C =============
-C Output
-C =============
-C
-C Q: mixing ratios at future time (t+NDT) (original values are over-written)
-C W(NLAY): large-scale vertical mass flux as diagnosed from the hydrostatic
-C          relationship. W will have the same unit as PS1 and PS2 (eg, mb).
-C          W must be divided by NDT to get the correct mass-flux unit.
-C          The vertical Courant number C = W/delp_UPWIND, where delp_UPWIND
-C          is the pressure thickness in the "upwind" direction. For example,
-C          C(k) = W(k)/delp(k)   if W(k) > 0;
-C          C(k) = W(k)/delp(k+1) if W(k) < 0.
-C              ( W > 0 is downward, ie, toward surface)
-C PS2: predicted PS at t+NDT (original values are over-written)
-C
-C ********************************************************************
-C NOTES:
-C This forward-in-time upstream-biased transport scheme reduces to
-C the 2nd order center-in-time center-in-space mass continuity eqn.
-C if Q = 1 (constant fields will remain constant). This also ensures
-C that the computed vertical velocity to be identical to GEOS-1 GCM
-C for on-line transport.
-C
-C A larger polar cap is used if j1=3 (recommended for C-Grid winds or when
-C winds are noisy near poles).
-C
-C Flux-Form Semi-Lagrangian transport in the East-West direction is used
-C when and where Courant # is greater than one.
-C
-C The user needs to change the parameter Jmax or Kmax if the resolution
-C is greater than 0.5 deg in N-S or 150 layers in the vertical direction.
-C (this TransPort Core is otherwise resolution independent and can be used
-C as a library routine).
-C
-C PPM is 4th order accurate when grid spacing is uniform (x & y); 3rd
-C order accurate for non-uniform grid (vertical sigma coord.).
-C
-C Time step is limitted only by transport in the meridional direction.
-C (the FFSL scheme is not implemented in the meridional direction).
-C
-C Since only 1-D limiters are applied, negative values could
-C potentially be generated when large time step is used and when the
-C initial fields contain discontinuities.
-C This does not necessarily imply the integration is unstable.
-C These negatives are typically very small. A filling algorithm is
-C activated if the user set "fill" to be true.
-C
-C The van Leer scheme used here is nearly as accurate as the original PPM
-C due to the use of a 4th order accurate reference slope. The PPM imple-
-C mented here is an improvement over the original and is also based on
-C the 4th order reference slope.
-C
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-C     User modifiable parameters
-C
-      parameter (Jmax = 361, kmax = 150)
-C
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-C Input-Output arrays
-C
-      
-      real Q(IMR,JNP,NLAY,NC),PS1(IMR,JNP),PS2(IMR,JNP),
-     &     U(IMR,JNP,NLAY),V(IMR,JNP,NLAY),AP(NLAY+1),
-     &     BP(NLAY+1),W(IMR,JNP,NLAY),NDT,val(NLAY),Umax
-      integer IGD,IORD,JORD,KORD,NC,IMR,JNP,j1,NLAY,AE
-      integer IMRD2
-      real    PT       
-      logical  cross, fill, dum
-C
-C Local dynamic arrays
-C
-      real CRX(IMR,JNP),CRY(IMR,JNP),xmass(IMR,JNP),ymass(IMR,JNP),
-     &     fx1(IMR+1),DPI(IMR,JNP,NLAY),delp1(IMR,JNP,NLAY),
-     &     WK1(IMR,JNP,NLAY),PU(IMR,JNP),PV(IMR,JNP),DC2(IMR,JNP),
-     &     delp2(IMR,JNP,NLAY),DQ(IMR,JNP,NLAY,NC),VA(IMR,JNP),
-     &     UA(IMR,JNP),qtmp(-IMR:2*IMR)
-C
-C Local static  arrays
-C
-      real DTDX(Jmax), DTDX5(Jmax), acosp(Jmax),
-     &     cosp(Jmax), cose(Jmax), DAP(kmax),DBK(Kmax)
-      data NDT0, NSTEP /0, 0/
-      data cross /.true./
-      SAVE DTDY, DTDY5, RCAP, JS0, JN0, IML,
-     &     DTDX, DTDX5, ACOSP, COSP, COSE, DAP,DBK
-C
-            
-      JMR = JNP -1
-      IMJM  = IMR*JNP
-      j2 = JNP - j1 + 1
-      NSTEP = NSTEP + 1
-C
-C *********** Initialization **********************
-      if(NSTEP.eq.1) then
-c
-      write(6,*) '------------------------------------ '
-      write(6,*) 'NASA/GSFC Transport Core Version 4.5'
-      write(6,*) '------------------------------------ '
-c
-      WRITE(6,*) 'IMR=',IMR,' JNP=',JNP,' NLAY=',NLAY,' j1=',j1
-      WRITE(6,*) 'NC=',NC,IORD,JORD,KORD,NDT
-C
-C controles sur les parametres
-      if(NLAY.LT.6) then
-        write(6,*) 'NLAY must be >= 6'
-        stop
-      endif
-      if (JNP.LT.NLAY) then
-         write(6,*) 'JNP must be >= NLAY'
-        stop
-      endif
-      IMRD2=mod(IMR,2)
-      if (j1.eq.2.and.IMRD2.NE.0) then
-         write(6,*) 'if j1=2 IMR must be an even integer'
-        stop
-      endif
-
-C
-      if(Jmax.lt.JNP .or. Kmax.lt.NLAY) then
-        write(6,*) 'Jmax or Kmax is too small'
-        stop
-      endif
-C
-      DO k=1,NLAY
-      DAP(k) = (AP(k+1) - AP(k))*PT
-      DBK(k) =  BP(k+1) - BP(k)
-      ENDDO     
-C
-      PI = 4. * ATAN(1.)
-      DL = 2.*PI / REAL(IMR)
-      DP =    PI / REAL(JMR)
-C
-      if(IGD.eq.0) then
-C Compute analytic cosine at cell edges
-            call cosa(cosp,cose,JNP,PI,DP)
-      else
-C Define cosine consistent with GEOS-GCM (using dycore2.0 or later)
-            call cosc(cosp,cose,JNP,PI,DP)
-      endif
-C
-      do 15 J=2,JMR
-15    acosp(j) = 1. / cosp(j)
-C
-C Inverse of the Scaled polar cap area.
-C
-      RCAP  = DP / (IMR*(1.-COS((j1-1.5)*DP)))
-      acosp(1)   = RCAP
-      acosp(JNP) = RCAP
-      endif
-C
-      if(NDT0 .ne. NDT) then
-      DT   = NDT
-      NDT0 = NDT
-
-	if(Umax .lt. 180.) then
-         write(6,*) 'Umax may be too small!'
-	endif
-      CR1  = abs(Umax*DT)/(DL*AE)
-      MaxDT = DP*AE / abs(Umax) + 0.5
-      write(6,*)'Largest time step for max(V)=',Umax,' is ',MaxDT
-      if(MaxDT .lt. abs(NDT)) then
-            write(6,*) 'Warning!!! NDT maybe too large!'
-      endif
-C
-      if(CR1.ge.0.95) then
-      JS0 = 0
-      JN0 = 0
-      IML = IMR-2
-      ZTC = 0.
-      else
-      ZTC  = acos(CR1) * (180./PI)
-C
-      JS0 = REAL(JMR)*(90.-ZTC)/180. + 2
-      JS0 = max(JS0, J1+1)
-      IML = min(6*JS0/(J1-1)+2, 4*IMR/5)
-      JN0 = JNP-JS0+1
-      endif
-C     
-C
-      do J=2,JMR
-      DTDX(j)  = DT / ( DL*AE*COSP(J) )
-
-c     print*,'dtdx=',dtdx(j)
-      DTDX5(j) = 0.5*DTDX(j)
-      enddo
-C
-      
-      DTDY  = DT /(AE*DP)
-c      print*,'dtdy=',dtdy
-      DTDY5 = 0.5*DTDY
-C
-c      write(6,*) 'J1=',J1,' J2=', J2
-      endif
-C
-C *********** End Initialization **********************
-C
-C delp = pressure thickness: the psudo-density in a hydrostatic system.
-      do  k=1,NLAY
-         do  j=1,JNP
-            do  i=1,IMR
-               delp1(i,j,k)=DAP(k)+DBK(k)*PS1(i,j)
-               delp2(i,j,k)=DAP(k)+DBK(k)*PS2(i,j)       
-            enddo
-         enddo
-      enddo
-          
-C
-      if(j1.ne.2) then
-      DO 40 IC=1,NC
-      DO 40 L=1,NLAY
-      DO 40 I=1,IMR
-      Q(I,  2,L,IC) = Q(I,  1,L,IC)
-40    Q(I,JMR,L,IC) = Q(I,JNP,L,IC)
-      endif
-C
-C Compute "tracer density"
-      DO 550 IC=1,NC
-      DO 44 k=1,NLAY
-      DO 44 j=1,JNP
-      DO 44 i=1,IMR
-44    DQ(i,j,k,IC) = Q(i,j,k,IC)*delp1(i,j,k)
-550	continue
-C
-      do 1500 k=1,NLAY
-C
-      if(IGD.eq.0) then
-C Convert winds on A-Grid to Courant # on C-Grid.
-      call A2C(U(1,1,k),V(1,1,k),IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
-      else
-C Convert winds on C-grid to Courant #
-      do 45 j=j1,j2
-      do 45 i=2,IMR
-45    CRX(i,J) = dtdx(j)*U(i-1,j,k)
-   
-C
-      do 50 j=j1,j2
-50    CRX(1,J) = dtdx(j)*U(IMR,j,k)
-C
-      do 55 i=1,IMR*JMR
-55    CRY(i,2) = DTDY*V(i,1,k)
-      endif
-C     
-C Determine JS and JN
-      JS = j1
-      JN = j2
-C
-      do j=JS0,j1+1,-1
-      do i=1,IMR
-      if(abs(CRX(i,j)).GT.1.) then
-            JS = j
-            go to 2222
-      endif
-      enddo
-      enddo
-C
-2222  continue
-      do j=JN0,j2-1
-      do i=1,IMR
-      if(abs(CRX(i,j)).GT.1.) then
-            JN = j
-            go to 2233
-      endif
-      enddo
-      enddo
-2233  continue
-C
-      if(j1.ne.2) then           ! Enlarged polar cap.
-      do i=1,IMR
-      DPI(i,  2,k) = 0.
-      DPI(i,JMR,k) = 0.
-      enddo
-      endif
-C
-C ******* Compute horizontal mass fluxes ************
-C
-C N-S component
-      do j=j1,j2+1
-      D5 = 0.5 * COSE(j)
-      do i=1,IMR
-      ymass(i,j) = CRY(i,j)*D5*(delp2(i,j,k) + delp2(i,j-1,k))
-      enddo
-      enddo
-C
-      do 95 j=j1,j2
-      DO 95 i=1,IMR
-95    DPI(i,j,k) = (ymass(i,j) - ymass(i,j+1)) * acosp(j)
-C
-C Poles
-      sum1 = ymass(IMR,j1  )
-      sum2 = ymass(IMR,J2+1)
-      do i=1,IMR-1
-      sum1 = sum1 + ymass(i,j1  )
-      sum2 = sum2 + ymass(i,J2+1)
-      enddo
-C
-      sum1 = - sum1 * RCAP
-      sum2 =   sum2 * RCAP
-      do i=1,IMR
-      DPI(i,  1,k) = sum1
-      DPI(i,JNP,k) = sum2
-      enddo
-C
-C E-W component
-C
-      do j=j1,j2
-      do i=2,IMR
-      PU(i,j) = 0.5 * (delp2(i,j,k) + delp2(i-1,j,k))
-      enddo
-      enddo
-C
-      do j=j1,j2
-      PU(1,j) = 0.5 * (delp2(1,j,k) + delp2(IMR,j,k))
-      enddo
-C
-      do 110 j=j1,j2
-      DO 110 i=1,IMR
-110   xmass(i,j) = PU(i,j)*CRX(i,j)
-C
-      DO 120 j=j1,j2
-      DO 120 i=1,IMR-1
-120   DPI(i,j,k) = DPI(i,j,k) + xmass(i,j) - xmass(i+1,j)
-C
-      DO 130 j=j1,j2
-130   DPI(IMR,j,k) = DPI(IMR,j,k) + xmass(IMR,j) - xmass(1,j)
-C
-      DO j=j1,j2
-      do i=1,IMR-1
-      UA(i,j) = 0.5 * (CRX(i,j)+CRX(i+1,j))
-      enddo
-      enddo
-C
-      DO j=j1,j2
-      UA(imr,j) = 0.5 * (CRX(imr,j)+CRX(1,j))
-      enddo
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c Rajouts pour LMDZ.3.3
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      do i=1,IMR
-         do j=1,JNP
-             VA(i,j)=0.
-         enddo
-      enddo
-
-      do i=1,imr*(JMR-1)
-      VA(i,2) = 0.5*(CRY(i,2)+CRY(i,3))
-      enddo
-C
-      if(j1.eq.2) then
-	IMH = IMR/2
-      do i=1,IMH
-      VA(i,      1) = 0.5*(CRY(i,2)-CRY(i+IMH,2))
-      VA(i+IMH,  1) = -VA(i,1)
-      VA(i,    JNP) = 0.5*(CRY(i,JNP)-CRY(i+IMH,JMR))
-      VA(i+IMH,JNP) = -VA(i,JNP)
-      enddo
-      VA(IMR,1)=VA(1,1)
-      VA(IMR,JNP)=VA(1,JNP)
-      endif
-C
-C ****6***0*********0*********0*********0*********0*********0**********72
-      do 1000 IC=1,NC
-C
-      do i=1,IMJM
-      wk1(i,1,1) = 0.
-      wk1(i,1,2) = 0.
-      enddo
-C
-C E-W advective cross term
-      do 250 j=J1,J2
-      if(J.GT.JS  .and. J.LT.JN) GO TO 250
-C
-      do i=1,IMR
-      qtmp(i) = q(i,j,k,IC)
-      enddo
-C
-      do i=-IML,0
-      qtmp(i)       = q(IMR+i,j,k,IC)
-      qtmp(IMR+1-i) = q(1-i,j,k,IC)
-      enddo
-C
-      DO 230 i=1,IMR
-      iu = UA(i,j)
-      ru = UA(i,j) - iu
-      iiu = i-iu
-      if(UA(i,j).GE.0.) then
-      wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
-      else
-      wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
-      endif
-      wk1(i,j,1) = wk1(i,j,1) - qtmp(i)
-230   continue
-250   continue
-C
-      if(JN.ne.0) then
-      do j=JS+1,JN-1
-C
-      do i=1,IMR
-      qtmp(i) = q(i,j,k,IC)
-      enddo
-C
-      qtmp(0)     = q(IMR,J,k,IC)
-      qtmp(IMR+1) = q(  1,J,k,IC)
-C
-      do i=1,imr
-      iu = i - UA(i,j)
-      wk1(i,j,1) = UA(i,j)*(qtmp(iu) - qtmp(iu+1))
-      enddo
-      enddo
-      endif
-C ****6***0*********0*********0*********0*********0*********0**********72
-C Contribution from the N-S advection
-      do i=1,imr*(j2-j1+1)
-      JT = REAL(J1) - VA(i,j1)
-      wk1(i,j1,2) = VA(i,j1) * (q(i,jt,k,IC) - q(i,jt+1,k,IC))
-      enddo
-C
-      do i=1,IMJM
-      wk1(i,1,1) = q(i,1,k,IC) + 0.5*wk1(i,1,1)
-      wk1(i,1,2) = q(i,1,k,IC) + 0.5*wk1(i,1,2)
-      enddo
-C
-	if(cross) then
-C Add cross terms in the vertical direction.
-	if(IORD .GE. 2) then
-		iad = 2
-	else
-		iad = 1
-	endif
-C
-	if(JORD .GE. 2) then
-		jad = 2
-	else
-		jad = 1
-	endif
-      call xadv(IMR,JNP,j1,j2,wk1(1,1,2),UA,JS,JN,IML,DC2,iad)
-      call yadv(IMR,JNP,j1,j2,wk1(1,1,1),VA,PV,W,jad)
-      do j=1,JNP
-      do i=1,IMR
-      q(i,j,k,IC) = q(i,j,k,IC) + DC2(i,j) + PV(i,j)
-      enddo
-      enddo
-      endif
-C
-      call xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ(1,1,k,IC),wk1(1,1,2)
-     &        ,CRX,fx1,xmass,IORD)
-
-      call ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ(1,1,k,IC),wk1(1,1,1),CRY,
-     &  DC2,ymass,WK1(1,1,3),wk1(1,1,4),WK1(1,1,5),WK1(1,1,6),JORD)
-C
-1000  continue
-1500  continue
-C
-C ******* Compute vertical mass flux (same unit as PS) ***********
-C
-C 1st step: compute total column mass CONVERGENCE.
-C
-      do 320 j=1,JNP
-      do 320 i=1,IMR
-320   CRY(i,j) = DPI(i,j,1)
-C
-      do 330 k=2,NLAY
-      do 330 j=1,JNP
-      do 330 i=1,IMR
-      CRY(i,j)  = CRY(i,j) + DPI(i,j,k)
-330   continue
-C
-      do 360 j=1,JNP
-      do 360 i=1,IMR
-C
-C 2nd step: compute PS2 (PS at n+1) using the hydrostatic assumption.
-C Changes (increases) to surface pressure = total column mass convergence
-C
-      PS2(i,j)  = PS1(i,j) + CRY(i,j)
-C
-C 3rd step: compute vertical mass flux from mass conservation principle.
-C
-      W(i,j,1) = DPI(i,j,1) - DBK(1)*CRY(i,j)
-      W(i,j,NLAY) = 0.
-360   continue
-C
-      do 370 k=2,NLAY-1
-      do 370 j=1,JNP
-      do 370 i=1,IMR
-      W(i,j,k) = W(i,j,k-1) + DPI(i,j,k) - DBK(k)*CRY(i,j)
-370   continue
-C
-      DO 380 k=1,NLAY
-      DO 380 j=1,JNP
-      DO 380 i=1,IMR
-      delp2(i,j,k) = DAP(k) + DBK(k)*PS2(i,j)
-380   continue
-C
-	KRD = max(3, KORD)
-      do 4000 IC=1,NC
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-   
-      call FZPPM(IMR,JNP,NLAY,j1,DQ(1,1,1,IC),W,Q(1,1,1,IC),WK1,DPI,
-     &           DC2,CRX,CRY,PU,PV,xmass,ymass,delp1,KRD)
-C
-    
-      if(fill) call qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2,
-     &                     cosp,acosp,.false.,IC,NSTEP)
-C
-C Recover tracer mixing ratio from "density" using predicted
-C "air density" (pressure thickness) at time-level n+1
-C
-      DO k=1,NLAY
-      DO j=1,JNP
-      DO i=1,IMR
-            Q(i,j,k,IC) = DQ(i,j,k,IC) / delp2(i,j,k)
-c            print*,'i=',i,'j=',j,'k=',k,'Q(i,j,k,IC)=',Q(i,j,k,IC)
-      enddo
-      enddo
-      enddo
-C     
-      if(j1.ne.2) then
-      DO 400 k=1,NLAY
-      DO 400 I=1,IMR
-c     j=1 c'est le pôle Sud, j=JNP c'est le pôle Nord
-      Q(I,  2,k,IC) = Q(I,  1,k,IC)
-      Q(I,JMR,k,IC) = Q(I,JNP,k,IC)
-400   CONTINUE
-      endif
-4000  continue
-C
-      if(j1.ne.2) then
-      DO 5000 k=1,NLAY
-      DO 5000 i=1,IMR
-      W(i,  2,k) = W(i,  1,k)
-      W(i,JMR,k) = W(i,JNP,k)
-5000  continue
-      endif
-C
-      RETURN
-      END
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-      subroutine FZPPM(IMR,JNP,NLAY,j1,DQ,WZ,P,DC,DQDT,AR,AL,A6,
-     &                 flux,wk1,wk2,wz2,delp,KORD)
-      parameter ( kmax = 150 )
-      parameter ( R23 = 2./3., R3 = 1./3.)
-      real WZ(IMR,JNP,NLAY),P(IMR,JNP,NLAY),DC(IMR,JNP,NLAY),
-     &     wk1(IMR,*),delp(IMR,JNP,NLAY),DQ(IMR,JNP,NLAY),
-     &     DQDT(IMR,JNP,NLAY)
-C Assuming JNP >= NLAY
-      real AR(IMR,*),AL(IMR,*),A6(IMR,*),flux(IMR,*),wk2(IMR,*),
-     &     wz2(IMR,*)
-C
-      JMR = JNP - 1
-      IMJM = IMR*JNP
-      NLAYM1 = NLAY - 1
-C
-      LMT = KORD - 3
-C
-C ****6***0*********0*********0*********0*********0*********0**********72
-C Compute DC for PPM
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-      do 1000 k=1,NLAYM1
-      do 1000 i=1,IMJM
-      DQDT(i,1,k) = P(i,1,k+1) - P(i,1,k)
-1000  continue
-C
-      DO 1220 k=2,NLAYM1
-      DO 1220 I=1,IMJM    
-       c0 =  delp(i,1,k) / (delp(i,1,k-1)+delp(i,1,k)+delp(i,1,k+1))
-       c1 = (delp(i,1,k-1)+0.5*delp(i,1,k))/(delp(i,1,k+1)+delp(i,1,k))    
-       c2 = (delp(i,1,k+1)+0.5*delp(i,1,k))/(delp(i,1,k-1)+delp(i,1,k))
-      tmp = c0*(c1*DQDT(i,1,k) + c2*DQDT(i,1,k-1))
-      Qmax = max(P(i,1,k-1),P(i,1,k),P(i,1,k+1)) - P(i,1,k)
-      Qmin = P(i,1,k) - min(P(i,1,k-1),P(i,1,k),P(i,1,k+1))
-      DC(i,1,k) = sign(min(abs(tmp),Qmax,Qmin), tmp)   
-1220  CONTINUE
-     
-C     
-C ****6***0*********0*********0*********0*********0*********0**********72
-C Loop over latitudes  (to save memory)
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-      DO 2000 j=1,JNP
-      if((j.eq.2 .or. j.eq.JMR) .and. j1.ne.2) goto 2000
-C
-      DO k=1,NLAY
-      DO i=1,IMR
-      wz2(i,k) =   WZ(i,j,k)
-      wk1(i,k) =    P(i,j,k)
-      wk2(i,k) = delp(i,j,k)
-      flux(i,k) = DC(i,j,k)  !this flux is actually the monotone slope
-      enddo
-      enddo
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-C Compute first guesses at cell interfaces
-C First guesses are required to be continuous.
-C ****6***0*********0*********0*********0*********0*********0**********72
-C
-C three-cell parabolic subgrid distribution at model top
-C two-cell parabolic with zero gradient subgrid distribution 
-C at the surface.
-C
-C First guess top edge value
-      DO 10 i=1,IMR
-C three-cell PPM
-C Compute a,b, and c of q = aP**2 + bP + c using cell averages and delp
-      a = 3.*( DQDT(i,j,2) - DQDT(i,j,1)*(wk2(i,2)+wk2(i,3))/
-     &         (wk2(i,1)+wk2(i,2)) ) /
-     &       ( (wk2(i,2)+wk2(i,3))*(wk2(i,1)+wk2(i,2)+wk2(i,3)) )
-      b = 2.*DQDT(i,j,1)/(wk2(i,1)+wk2(i,2)) - 
-     &    R23*a*(2.*wk2(i,1)+wk2(i,2))
-      AL(i,1) =  wk1(i,1) - wk2(i,1)*(R3*a*wk2(i,1) + 0.5*b)
-      AL(i,2) =  wk2(i,1)*(a*wk2(i,1) + b) + AL(i,1)
-C
-C Check if change sign
-      if(wk1(i,1)*AL(i,1).le.0.) then
-		 AL(i,1) = 0.
-             flux(i,1) = 0.
-	else
-             flux(i,1) =  wk1(i,1) - AL(i,1)
-	endif
-10    continue
-C
-C Bottom
-      DO 15 i=1,IMR
-C 2-cell PPM with zero gradient right at the surface
-C
-      fct = DQDT(i,j,NLAYM1)*wk2(i,NLAY)**2 /
-     & ( (wk2(i,NLAY)+wk2(i,NLAYM1))*(2.*wk2(i,NLAY)+wk2(i,NLAYM1)))
-      AR(i,NLAY) = wk1(i,NLAY) + fct
-      AL(i,NLAY) = wk1(i,NLAY) - (fct+fct)
-      if(wk1(i,NLAY)*AR(i,NLAY).le.0.) AR(i,NLAY) = 0.
-      flux(i,NLAY) = AR(i,NLAY) -  wk1(i,NLAY)
-15    continue
-     
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-C 4th order interpolation in the interior.
-C****6***0*********0*********0*********0*********0*********0**********72
-C
-      DO 14 k=3,NLAYM1
-      DO 12 i=1,IMR
-      c1 =  DQDT(i,j,k-1)*wk2(i,k-1) / (wk2(i,k-1)+wk2(i,k))
-      c2 =  2. / (wk2(i,k-2)+wk2(i,k-1)+wk2(i,k)+wk2(i,k+1))
-      A1   =  (wk2(i,k-2)+wk2(i,k-1)) / (2.*wk2(i,k-1)+wk2(i,k))
-      A2   =  (wk2(i,k  )+wk2(i,k+1)) / (2.*wk2(i,k)+wk2(i,k-1))
-      AL(i,k) = wk1(i,k-1) + c1 + c2 *
-     &        ( wk2(i,k  )*(c1*(A1 - A2)+A2*flux(i,k-1)) -
-     &          wk2(i,k-1)*A1*flux(i,k)  )
-C      print *,'AL1',i,k, AL(i,k)
-12    CONTINUE
-14    continue
-C
-      do 20 i=1,IMR*NLAYM1
-      AR(i,1) = AL(i,2)
-C      print *,'AR1',i,AR(i,1)
-20    continue
-C
-      do 30 i=1,IMR*NLAY
-      A6(i,1) = 3.*(wk1(i,1)+wk1(i,1) - (AL(i,1)+AR(i,1)))
-C      print *,'A61',i,A6(i,1)
-30    continue
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-C Top & Bot always monotonic
-      call lmtppm(flux(1,1),A6(1,1),AR(1,1),AL(1,1),wk1(1,1),IMR,0)
-      call lmtppm(flux(1,NLAY),A6(1,NLAY),AR(1,NLAY),AL(1,NLAY),
-     &            wk1(1,NLAY),IMR,0)
-C
-C Interior depending on KORD
-      if(LMT.LE.2)
-     &  call lmtppm(flux(1,2),A6(1,2),AR(1,2),AL(1,2),wk1(1,2),
-     &              IMR*(NLAY-2),LMT)
-C
-C****6***0*********0*********0*********0*********0*********0**********72
-C
-      DO 140 i=1,IMR*NLAYM1
-      IF(wz2(i,1).GT.0.) then
-        CM = wz2(i,1) / wk2(i,1)
-        flux(i,2) = AR(i,1)+0.5*CM*(AL(i,1)-AR(i,1)+A6(i,1)*(1.-R23*CM))
-      else
-C        print *,'test2-0',i,j,wz2(i,1),wk2(i,2)
-        CP= wz2(i,1) / wk2(i,2)        
-C        print *,'testCP',CP
-        flux(i,2) = AL(i,2)+0.5*CP*(AL(i,2)-AR(i,2)-A6(i,2)*(1.+R23*CP))
-C        print *,'test2',i, AL(i,2),AR(i,2),A6(i,2),R23
-      endif
-140   continue
-C
-      DO 250 i=1,IMR*NLAYM1
-      flux(i,2) = wz2(i,1) * flux(i,2)
-250   continue
-C
-      do 350 i=1,IMR
-      DQ(i,j,   1) = DQ(i,j,   1) - flux(i,   2)
-      DQ(i,j,NLAY) = DQ(i,j,NLAY) + flux(i,NLAY)
-350   continue
-C
-      do 360 k=2,NLAYM1
-      do 360 i=1,IMR
-360   DQ(i,j,k) = DQ(i,j,k) + flux(i,k) - flux(i,k+1)
-2000  continue
-      return
-      end
-C
-      subroutine xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ,Q,UC,
-     &               fx1,xmass,IORD)
-      dimension UC(IMR,*),DC(-IML:IMR+IML+1),xmass(IMR,JNP)
-     &    ,fx1(IMR+1),DQ(IMR,JNP),qtmp(-IML:IMR+1+IML)
-      dimension PU(IMR,JNP),Q(IMR,JNP),ISAVE(IMR)
-C
-      IMP = IMR + 1
-C
-C van Leer at high latitudes
-      jvan = max(1,JNP/18)
-      j1vl = j1+jvan
-      j2vl = j2-jvan
-C
-      do 1310 j=j1,j2
-C
-      do i=1,IMR
-      qtmp(i) = q(i,j)
-      enddo
-C
-      if(j.ge.JN .or. j.le.JS) goto 2222
-C ************* Eulerian **********
-C
-      qtmp(0)     = q(IMR,J)
-      qtmp(-1)    = q(IMR-1,J)
-      qtmp(IMP)   = q(1,J)
-      qtmp(IMP+1) = q(2,J)
-C
-      IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
-      DO 1406 i=1,IMR
-      iu = REAL(i) - uc(i,j)
-1406  fx1(i) = qtmp(iu)
-      ELSE
-      call xmist(IMR,IML,Qtmp,DC)
-      DC(0) = DC(IMR)
-C
-      if(IORD.eq.2 .or. j.le.j1vl .or. j.ge.j2vl) then
-      DO 1408 i=1,IMR
-      iu = REAL(i) - uc(i,j)
-1408  fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j))
-      else
-      call fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
-      endif
-C
-      ENDIF
-C
-      DO 1506 i=1,IMR
-1506  fx1(i) = fx1(i)*xmass(i,j)
-C
-      goto 1309
-C
-C ***** Conservative (flux-form) Semi-Lagrangian transport *****
-C
-2222  continue
-C
-      do i=-IML,0
-      qtmp(i)     = q(IMR+i,j)
-      qtmp(IMP-i) = q(1-i,j)
-      enddo
-C
-      IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
-      DO 1306 i=1,IMR
-      itmp = INT(uc(i,j))
-      ISAVE(i) = i - itmp
-      iu = i - uc(i,j)
-1306  fx1(i) = (uc(i,j) - itmp)*qtmp(iu)
-      ELSE
-      call xmist(IMR,IML,Qtmp,DC)
-C
-      do i=-IML,0
-      DC(i)     = DC(IMR+i)
-      DC(IMP-i) = DC(1-i)
-      enddo
-C
-      DO 1307 i=1,IMR
-      itmp = INT(uc(i,j))
-      rut  = uc(i,j) - itmp
-      ISAVE(i) = i - itmp
-      iu = i - uc(i,j)
-1307  fx1(i) = rut*(qtmp(iu) + DC(iu)*(sign(1.,rut) - rut))
-      ENDIF
-C
-      do 1308 i=1,IMR
-      IF(uc(i,j).GT.1.) then
-CDIR$ NOVECTOR
-        do ist = ISAVE(i),i-1
-        fx1(i) = fx1(i) + qtmp(ist)
-        enddo
-      elseIF(uc(i,j).LT.-1.) then
-        do ist = i,ISAVE(i)-1
-        fx1(i) = fx1(i) - qtmp(ist)
-        enddo
-CDIR$ VECTOR
-      endif
-1308  continue
-      do i=1,IMR
-      fx1(i) = PU(i,j)*fx1(i)
-      enddo
-C
-C ***************************************
-C
-1309  fx1(IMP) = fx1(1)
-      DO 1215 i=1,IMR
-1215  DQ(i,j) =  DQ(i,j) + fx1(i)-fx1(i+1)
-C
-C ***************************************
-C
-1310  continue
-      return
-      end
-C
-      subroutine fxppm(IMR,IML,UT,P,DC,flux,IORD)
-      parameter ( R3 = 1./3., R23 = 2./3. )
-      DIMENSION UT(*),flux(*),P(-IML:IMR+IML+1),DC(-IML:IMR+IML+1)
-      DIMENSION AR(0:IMR),AL(0:IMR),A6(0:IMR)
-      integer LMT 
-c      logical first
-c      data first /.true./
-c      SAVE LMT
-c      if(first) then
-C
-C correction calcul de LMT a chaque passage pour pouvoir choisir
-c plusieurs schemas PPM pour differents traceurs
-c      IF (IORD.LE.0) then
-c            if(IMR.GE.144) then
-c                  LMT = 0
-c            elseif(IMR.GE.72) then
-c                  LMT = 1
-c            else
-c                  LMT = 2
-c            endif
-c      else
-c            LMT = IORD - 3
-c      endif
-C
-      LMT = IORD - 3
-c      write(6,*) 'PPM option in E-W direction = ', LMT
-c      first = .false.
-C      endif
-C
-      DO 10 i=1,IMR
-10    AL(i) = 0.5*(p(i-1)+p(i)) + (DC(i-1) - DC(i))*R3
-C
-      do 20 i=1,IMR-1
-20    AR(i) = AL(i+1)
-      AR(IMR) = AL(1)
-C
-      do 30 i=1,IMR
-30    A6(i) = 3.*(p(i)+p(i)  - (AL(i)+AR(i)))
-C
-      if(LMT.LE.2) call lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
-C
-      AL(0) = AL(IMR)
-      AR(0) = AR(IMR)
-      A6(0) = A6(IMR)
-C
-      DO i=1,IMR
-      IF(UT(i).GT.0.) then
-      flux(i) = AR(i-1) + 0.5*UT(i)*(AL(i-1) - AR(i-1) +
-     &                 A6(i-1)*(1.-R23*UT(i)) )
-      else
-      flux(i) = AL(i) - 0.5*UT(i)*(AR(i) - AL(i) +
-     &                        A6(i)*(1.+R23*UT(i)))
-      endif
-      enddo
-      return
-      end
-C
-      subroutine xmist(IMR,IML,P,DC)
-      parameter( R24 = 1./24.)
-      dimension P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
-C
-      do 10  i=1,IMR
-      tmp = R24*(8.*(p(i+1) - p(i-1)) + p(i-2) - p(i+2))
-      Pmax = max(P(i-1), p(i), p(i+1)) - p(i)
-      Pmin = p(i) - min(P(i-1), p(i), p(i+1))
-10    DC(i) = sign(min(abs(tmp),Pmax,Pmin), tmp)
-      return
-      end
-C
-      subroutine ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ,P,VC,DC2
-     &              ,ymass,fx,A6,AR,AL,JORD)
-      dimension P(IMR,JNP),VC(IMR,JNP),ymass(IMR,JNP)
-     &       ,DC2(IMR,JNP),DQ(IMR,JNP),acosp(JNP)
-C Work array
-      DIMENSION fx(IMR,JNP),AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
-C
-      JMR = JNP - 1
-      len = IMR*(J2-J1+2)
-C
-      if(JORD.eq.1) then
-      DO 1000 i=1,len
-      JT = REAL(J1) - VC(i,J1)
-1000  fx(i,j1) = p(i,JT)
-      else
-   
-      call ymist(IMR,JNP,j1,P,DC2,4)
-C
-      if(JORD.LE.0 .or. JORD.GE.3) then
-   
-      call fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
-    
-      else
-      DO 1200 i=1,len
-      JT = REAL(J1) - VC(i,J1)
-1200  fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
-      endif
-      endif
-C
-      DO 1300 i=1,len
-1300  fx(i,j1) = fx(i,j1)*ymass(i,j1)
-C
-      DO 1400 j=j1,j2
-      DO 1400 i=1,IMR
-1400  DQ(i,j) = DQ(i,j) + (fx(i,j) - fx(i,j+1)) * acosp(j)
-C
-C Poles
-      sum1 = fx(IMR,j1  )
-      sum2 = fx(IMR,J2+1)
-      do i=1,IMR-1
-      sum1 = sum1 + fx(i,j1  )
-      sum2 = sum2 + fx(i,J2+1)
-      enddo
-C
-      sum1 = DQ(1,  1) - sum1 * RCAP
-      sum2 = DQ(1,JNP) + sum2 * RCAP
-      do i=1,IMR
-      DQ(i,  1) = sum1
-      DQ(i,JNP) = sum2
-      enddo
-C
-      if(j1.ne.2) then
-      do i=1,IMR
-      DQ(i,  2) = sum1
-      DQ(i,JMR) = sum2
-      enddo
-      endif
-C
-      return
-      end
-C
-      subroutine  ymist(IMR,JNP,j1,P,DC,ID)
-      parameter ( R24 = 1./24. )
-      dimension P(IMR,JNP),DC(IMR,JNP)
-C
-      IMH = IMR / 2
-      JMR = JNP - 1
-      IJM3 = IMR*(JMR-3)
-C
-      IF(ID.EQ.2) THEN
-      do 10 i=1,IMR*(JMR-1)
-      tmp = 0.25*(p(i,3) - p(i,1))
-      Pmax = max(p(i,1),p(i,2),p(i,3)) - p(i,2)
-      Pmin = p(i,2) - min(p(i,1),p(i,2),p(i,3))
-      DC(i,2) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-10    CONTINUE
-      ELSE
-      do 12 i=1,IMH
-C J=2
-      tmp = (8.*(p(i,3) - p(i,1)) + p(i+IMH,2) - p(i,4))*R24
-      Pmax = max(p(i,1),p(i,2),p(i,3)) - p(i,2)
-      Pmin = p(i,2) - min(p(i,1),p(i,2),p(i,3))
-      DC(i,2) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-C J=JMR
-      tmp=(8.*(p(i,JNP)-p(i,JMR-1))+p(i,JMR-2)-p(i+IMH,JMR))*R24
-      Pmax = max(p(i,JMR-1),p(i,JMR),p(i,JNP)) - p(i,JMR)
-      Pmin = p(i,JMR) - min(p(i,JMR-1),p(i,JMR),p(i,JNP))
-      DC(i,JMR) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-12    CONTINUE
-      do 14 i=IMH+1,IMR
-C J=2
-      tmp = (8.*(p(i,3) - p(i,1)) + p(i-IMH,2) - p(i,4))*R24
-      Pmax = max(p(i,1),p(i,2),p(i,3)) - p(i,2)
-      Pmin = p(i,2) - min(p(i,1),p(i,2),p(i,3))
-      DC(i,2) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-C J=JMR
-      tmp=(8.*(p(i,JNP)-p(i,JMR-1))+p(i,JMR-2)-p(i-IMH,JMR))*R24
-      Pmax = max(p(i,JMR-1),p(i,JMR),p(i,JNP)) - p(i,JMR)
-      Pmin = p(i,JMR) - min(p(i,JMR-1),p(i,JMR),p(i,JNP))
-      DC(i,JMR) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-14    CONTINUE
-C
-      do 15 i=1,IJM3
-      tmp = (8.*(p(i,4) - p(i,2)) + p(i,1) - p(i,5))*R24
-      Pmax = max(p(i,2),p(i,3),p(i,4)) - p(i,3)
-      Pmin = p(i,3) - min(p(i,2),p(i,3),p(i,4))
-      DC(i,3) = sign(min(abs(tmp),Pmin,Pmax),tmp)
-15    CONTINUE
-      ENDIF
-C
-      if(j1.ne.2) then
-      do i=1,IMR
-      DC(i,1) = 0.
-      DC(i,JNP) = 0.
-      enddo
-      else
-C Determine slopes in polar caps for scalars!
-C
-      do 13 i=1,IMH
-C South
-      tmp = 0.25*(p(i,2) - p(i+imh,2))
-      Pmax = max(p(i,2),p(i,1), p(i+imh,2)) - p(i,1)
-      Pmin = p(i,1) - min(p(i,2),p(i,1), p(i+imh,2))
-      DC(i,1)=sign(min(abs(tmp),Pmax,Pmin),tmp)
-C North.
-      tmp = 0.25*(p(i+imh,JMR) - p(i,JMR))
-      Pmax = max(p(i+imh,JMR),p(i,jnp), p(i,JMR)) - p(i,JNP)
-      Pmin = p(i,JNP) - min(p(i+imh,JMR),p(i,jnp), p(i,JMR))
-      DC(i,JNP) = sign(min(abs(tmp),Pmax,pmin),tmp)
-13    continue
-C
-      do 25 i=imh+1,IMR
-      DC(i,  1) =  - DC(i-imh,  1)
-      DC(i,JNP) =  - DC(i-imh,JNP)
-25    continue
-      endif
-      return
-      end
-C
-      subroutine fyppm(VC,P,DC,flux,IMR,JNP,j1,j2,A6,AR,AL,JORD)
-      parameter ( R3 = 1./3., R23 = 2./3. )
-      real VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
-C Local work arrays.
-      real AR(IMR,JNP),AL(IMR,JNP),A6(IMR,JNP)
-      integer LMT
-c      logical first
-C      data first /.true./
-C      SAVE LMT
-C
-      IMH = IMR / 2
-      JMR = JNP - 1
-      j11 = j1-1
-      IMJM1 = IMR*(J2-J1+2)
-      len   = IMR*(J2-J1+3)
-C      if(first) then
-C      IF(JORD.LE.0) then
-C            if(JMR.GE.90) then
-C                  LMT = 0
-C            elseif(JMR.GE.45) then
-C                  LMT = 1
-C            else
-C                  LMT = 2
-C            endif
-C      else
-C            LMT = JORD - 3
-C      endif
-C
-C      first = .false.
-C      endif
-C     
-c modifs pour pouvoir choisir plusieurs schemas PPM
-      LMT = JORD - 3      
-C
-      DO 10 i=1,IMR*JMR        
-      AL(i,2) = 0.5*(p(i,1)+p(i,2)) + (DC(i,1) - DC(i,2))*R3
-      AR(i,1) = AL(i,2)
-10    CONTINUE
-C
-CPoles:
-C
-      DO i=1,IMH
-      AL(i,1) = AL(i+IMH,2)
-      AL(i+IMH,1) = AL(i,2)
-C
-      AR(i,JNP) = AR(i+IMH,JMR)
-      AR(i+IMH,JNP) = AR(i,JMR)
-      ENDDO
-
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-c   Rajout pour LMDZ.3.3
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      AR(IMR,1)=AL(1,1)
-      AR(IMR,JNP)=AL(1,JNP)
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      
-           
-      do 30 i=1,len
-30    A6(i,j11) = 3.*(p(i,j11)+p(i,j11)  - (AL(i,j11)+AR(i,j11)))
-C
-      if(LMT.le.2) call lmtppm(DC(1,j11),A6(1,j11),AR(1,j11)
-     &                       ,AL(1,j11),P(1,j11),len,LMT)
-C
-     
-      DO 140 i=1,IMJM1
-      IF(VC(i,j1).GT.0.) then
-      flux(i,j1) = AR(i,j11) + 0.5*VC(i,j1)*(AL(i,j11) - AR(i,j11) +
-     &                         A6(i,j11)*(1.-R23*VC(i,j1)) )
-      else
-      flux(i,j1) = AL(i,j1) - 0.5*VC(i,j1)*(AR(i,j1) - AL(i,j1) +
-     &                        A6(i,j1)*(1.+R23*VC(i,j1)))
-      endif
-140   continue
-      return
-      end
-C
-	subroutine yadv(IMR,JNP,j1,j2,p,VA,ady,wk,IAD)
-	REAL p(IMR,JNP),ady(IMR,JNP),VA(IMR,JNP)
-        REAL WK(IMR,-1:JNP+2)
-C
-	JMR = JNP-1
-	IMH = IMR/2
-	do j=1,JNP
-	do i=1,IMR
-	wk(i,j) = p(i,j)
-	enddo
-	enddo
-C Poles:
-	do i=1,IMH
-	wk(i,   -1) = p(i+IMH,3)
-	wk(i+IMH,-1) = p(i,3)
-	wk(i,    0) = p(i+IMH,2)
-	wk(i+IMH,0) = p(i,2)
-	wk(i,JNP+1) = p(i+IMH,JMR)
-	wk(i+IMH,JNP+1) = p(i,JMR)
-	wk(i,JNP+2) = p(i+IMH,JNP-2)
-	wk(i+IMH,JNP+2) = p(i,JNP-2)
-	enddo
-c        write(*,*) 'toto 1' 
-C --------------------------------
-      IF(IAD.eq.2) then
-      do j=j1-1,j2+1
-      do i=1,IMR
-c      write(*,*) 'avt NINT','i=',i,'j=',j
-      JP = NINT(VA(i,j))      
-      rv = JP - VA(i,j)
-c      write(*,*) 'VA=',VA(i,j), 'JP1=',JP,'rv=',rv
-      JP = j - JP
-c      write(*,*) 'JP2=',JP
-      a1 = 0.5*(wk(i,jp+1)+wk(i,jp-1)) - wk(i,jp)
-      b1 = 0.5*(wk(i,jp+1)-wk(i,jp-1))
-c      write(*,*) 'a1=',a1,'b1=',b1
-      ady(i,j) = wk(i,jp) + rv*(a1*rv + b1) - wk(i,j)
-      enddo
-      enddo
-c      write(*,*) 'toto 2'
-C
-      ELSEIF(IAD.eq.1) then
-	do j=j1-1,j2+1
-      do i=1,imr
-      JP = REAL(j)-VA(i,j)
-      ady(i,j) = VA(i,j)*(wk(i,jp)-wk(i,jp+1))
-      enddo
-      enddo
-      ENDIF
-C
-	if(j1.ne.2) then
-	sum1 = 0.
-	sum2 = 0.
-      do i=1,imr
-      sum1 = sum1 + ady(i,2)
-      sum2 = sum2 + ady(i,JMR)
-      enddo
-	sum1 = sum1 / IMR
-	sum2 = sum2 / IMR
-C
-      do i=1,imr
-      ady(i,  2) =  sum1
-      ady(i,JMR) =  sum2
-      ady(i,  1) =  sum1
-      ady(i,JNP) =  sum2
-      enddo
-	else
-C Poles:
-	sum1 = 0.
-	sum2 = 0.
-      do i=1,imr
-      sum1 = sum1 + ady(i,1)
-      sum2 = sum2 + ady(i,JNP)
-      enddo
-	sum1 = sum1 / IMR
-	sum2 = sum2 / IMR
-C
-      do i=1,imr
-      ady(i,  1) =  sum1
-      ady(i,JNP) =  sum2
-      enddo
-	endif
-C
-	return
-	end
-C
-	subroutine xadv(IMR,JNP,j1,j2,p,UA,JS,JN,IML,adx,IAD)
-	REAL p(IMR,JNP),adx(IMR,JNP),qtmp(-IMR:IMR+IMR),UA(IMR,JNP)
-C
-	JMR = JNP-1
-      do 1309 j=j1,j2
-      if(J.GT.JS  .and. J.LT.JN) GO TO 1309
-C
-      do i=1,IMR
-      qtmp(i) = p(i,j)
-      enddo
-C
-      do i=-IML,0
-      qtmp(i)       = p(IMR+i,j)
-      qtmp(IMR+1-i) = p(1-i,j)
-      enddo
-C
-      IF(IAD.eq.2) THEN
-      DO i=1,IMR
-      IP = NINT(UA(i,j))
-      ru = IP - UA(i,j)
-      IP = i - IP
-      a1 = 0.5*(qtmp(ip+1)+qtmp(ip-1)) - qtmp(ip)
-      b1 = 0.5*(qtmp(ip+1)-qtmp(ip-1))
-      adx(i,j) = qtmp(ip) + ru*(a1*ru + b1)
-      enddo
-      ELSEIF(IAD.eq.1) then
-      DO i=1,IMR
-      iu = UA(i,j)
-      ru = UA(i,j) - iu
-      iiu = i-iu
-      if(UA(i,j).GE.0.) then
-      adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
-      else
-      adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
-      endif
-      enddo
-      ENDIF
-C
-      do i=1,IMR
-      adx(i,j) = adx(i,j) - p(i,j)
-      enddo
-1309  continue
-C
-C Eulerian upwind
-C
-      do j=JS+1,JN-1
-C
-      do i=1,IMR
-      qtmp(i) = p(i,j)
-      enddo
-C
-      qtmp(0)     = p(IMR,J)
-      qtmp(IMR+1) = p(1,J)
-C
-      IF(IAD.eq.2) THEN
-      qtmp(-1)     = p(IMR-1,J)
-      qtmp(IMR+2) = p(2,J)
-      do i=1,imr
-      IP = NINT(UA(i,j))
-      ru = IP - UA(i,j)
-      IP = i - IP
-      a1 = 0.5*(qtmp(ip+1)+qtmp(ip-1)) - qtmp(ip)
-      b1 = 0.5*(qtmp(ip+1)-qtmp(ip-1))
-      adx(i,j) = qtmp(ip)- p(i,j) + ru*(a1*ru + b1)
-      enddo
-      ELSEIF(IAD.eq.1) then
-C 1st order
-      DO i=1,IMR
-      IP = i - UA(i,j)
-      adx(i,j) = UA(i,j)*(qtmp(ip)-qtmp(ip+1))
-      enddo
-      ENDIF
-      enddo
-C
-	if(j1.ne.2) then
-      do i=1,IMR
-      adx(i,  2) = 0.
-      adx(i,JMR) = 0.
-      enddo
-	endif
-C set cross term due to x-adv at the poles to zero.
-      do i=1,IMR
-      adx(i,  1) = 0.
-      adx(i,JNP) = 0.
-      enddo
-	return
-	end
-C
-      subroutine lmtppm(DC,A6,AR,AL,P,IM,LMT)
-C
-C A6 =  CURVATURE OF THE TEST PARABOLA
-C AR =  RIGHT EDGE VALUE OF THE TEST PARABOLA
-C AL =  LEFT  EDGE VALUE OF THE TEST PARABOLA
-C DC =  0.5 * MISMATCH
-C P  =  CELL-AVERAGED VALUE
-C IM =  VECTOR LENGTH
-C
-C OPTIONS:
-C
-C LMT = 0: FULL MONOTONICITY
-C LMT = 1: SEMI-MONOTONIC CONSTRAINT (NO UNDERSHOOTS)
-C LMT = 2: POSITIVE-DEFINITE CONSTRAINT
-C
-      parameter ( R12 = 1./12. )
-      dimension A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
-C
-      if(LMT.eq.0) then
-C Full constraint
-      do 100 i=1,IM
-      if(DC(i).eq.0.) then
-            AR(i) = p(i)
-            AL(i) = p(i)
-            A6(i) = 0.
-      else
-      da1  = AR(i) - AL(i)
-      da2  = da1**2
-      A6DA = A6(i)*da1
-      if(A6DA .lt. -da2) then
-            A6(i) = 3.*(AL(i)-p(i))
-            AR(i) = AL(i) - A6(i)
-      elseif(A6DA .gt. da2) then
-            A6(i) = 3.*(AR(i)-p(i))
-            AL(i) = AR(i) - A6(i)
-      endif
-      endif
-100   continue
-      elseif(LMT.eq.1) then
-C Semi-monotonic constraint
-      do 150 i=1,IM
-      if(abs(AR(i)-AL(i)) .GE. -A6(i)) go to 150
-      if(p(i).lt.AR(i) .and. p(i).lt.AL(i)) then
-            AR(i) = p(i)
-            AL(i) = p(i)
-            A6(i) = 0.
-      elseif(AR(i) .gt. AL(i)) then
-            A6(i) = 3.*(AL(i)-p(i))
-            AR(i) = AL(i) - A6(i)
-      else
-            A6(i) = 3.*(AR(i)-p(i))
-            AL(i) = AR(i) - A6(i)
-      endif
-150   continue
-      elseif(LMT.eq.2) then
-      do 250 i=1,IM
-      if(abs(AR(i)-AL(i)) .GE. -A6(i)) go to 250
-      fmin = p(i) + 0.25*(AR(i)-AL(i))**2/A6(i) + A6(i)*R12
-      if(fmin.ge.0.) go to 250
-      if(p(i).lt.AR(i) .and. p(i).lt.AL(i)) then
-            AR(i) = p(i)
-            AL(i) = p(i)
-            A6(i) = 0.
-      elseif(AR(i) .gt. AL(i)) then
-            A6(i) = 3.*(AL(i)-p(i))
-            AR(i) = AL(i) - A6(i)
-      else
-            A6(i) = 3.*(AR(i)-p(i))
-            AL(i) = AR(i) - A6(i)
-      endif
-250   continue
-      endif
-      return
-      end
-C
-      subroutine A2C(U,V,IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
-      dimension U(IMR,*),V(IMR,*),CRX(IMR,*),CRY(IMR,*),DTDX5(*)
-C
-      do 35 j=j1,j2
-      do 35 i=2,IMR
-35    CRX(i,J) = dtdx5(j)*(U(i,j)+U(i-1,j))
-C
-      do 45 j=j1,j2
-45    CRX(1,J) = dtdx5(j)*(U(1,j)+U(IMR,j))
-C
-      do 55 i=1,IMR*JMR
-55    CRY(i,2) = DTDY5*(V(i,2)+V(i,1))
-      return
-      end
-C
-      subroutine cosa(cosp,cose,JNP,PI,DP)
-      dimension cosp(*),cose(*)
-      JMR = JNP-1
-      do 55 j=2,JNP
-        ph5  =  -0.5*PI + (REAL(J-1)-0.5)*DP
-55      cose(j) = cos(ph5)
-C
-      JEQ = (JNP+1) / 2
-      if(JMR .eq. 2*(JMR/2) ) then
-      do j=JNP, JEQ+1, -1
-       cose(j) =  cose(JNP+2-j)
-      enddo
-      else
-C cell edge at equator.
-       cose(JEQ+1) =  1.
-      do j=JNP, JEQ+2, -1
-       cose(j) =  cose(JNP+2-j)
-       enddo
-      endif
-C
-      do 66 j=2,JMR
-66    cosp(j) = 0.5*(cose(j)+cose(j+1))
-      cosp(1) = 0.
-      cosp(JNP) = 0.
-      return
-      end
-C
-      subroutine cosc(cosp,cose,JNP,PI,DP)
-      dimension cosp(*),cose(*)
-C
-      phi = -0.5*PI
-      do 55 j=2,JNP-1
-      phi  =  phi + DP
-55    cosp(j) = cos(phi)
-        cosp(  1) = 0.
-        cosp(JNP) = 0.
-C
-      do 66 j=2,JNP
-        cose(j) = 0.5*(cosp(j)+cosp(j-1))
-66    CONTINUE
-C
-      do 77 j=2,JNP-1
-       cosp(j) = 0.5*(cose(j)+cose(j+1))
-77    CONTINUE
-      return
-      end
-C
-      SUBROUTINE qckxyz (Q,qtmp,IMR,JNP,NLAY,j1,j2,cosp,acosp,
-     &                   cross,IC,NSTEP)
-C
-      parameter( tiny = 1.E-60 )
-      DIMENSION Q(IMR,JNP,NLAY),qtmp(IMR,JNP),cosp(*),acosp(*)
-      logical cross
-C
-      NLAYM1 = NLAY-1
-      len = IMR*(j2-j1+1)
-      ip = 0
-C
-C Top layer
-      L = 1
-	icr = 1
-      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-      if(ipy.eq.0) goto 50
-      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-      if(ipx.eq.0) goto 50
-C
-      if(cross) then
-      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-      endif
-      if(icr.eq.0) goto 50
-C
-C Vertical filling...
-      do i=1,len
-      IF( Q(i,j1,1).LT.0.) THEN
-      ip = ip + 1
-          Q(i,j1,2) = Q(i,j1,2) + Q(i,j1,1)
-          Q(i,j1,1) = 0.
-      endif
-      enddo
-C
-50    continue
-      DO 225 L = 2,NLAYM1
-      icr = 1
-C
-      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-      if(ipy.eq.0) goto 225
-      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-      if(ipx.eq.0) go to 225
-      if(cross) then
-      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-      endif
-      if(icr.eq.0) goto 225
-C
-      do i=1,len
-      IF( Q(I,j1,L).LT.0.) THEN
-C
-      ip = ip + 1
-C From above
-          qup =  Q(I,j1,L-1)
-          qly = -Q(I,j1,L)
-          dup  = min(qly,qup)
-          Q(I,j1,L-1) = qup - dup
-          Q(I,j1,L  ) = dup-qly
-C Below
-          Q(I,j1,L+1) = Q(I,j1,L+1) + Q(I,j1,L)
-          Q(I,j1,L)   = 0.
-      ENDIF
-      ENDDO
-225   CONTINUE
-C
-C BOTTOM LAYER
-      sum = 0.
-      L = NLAY
-C
-      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-      if(ipy.eq.0) goto 911
-      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
-      if(ipx.eq.0) goto 911
-C
-      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-      if(icr.eq.0) goto 911
-C
-      DO  I=1,len
-      IF( Q(I,j1,L).LT.0.) THEN
-      ip = ip + 1
-c
-C From above
-C
-          qup = Q(I,j1,NLAYM1)
-          qly = -Q(I,j1,L)
-          dup = min(qly,qup)
-          Q(I,j1,NLAYM1) = qup - dup
-C From "below" the surface.
-          sum = sum + qly-dup
-          Q(I,j1,L) = 0.
-       ENDIF
-      ENDDO
-C
-911   continue
-C
-      if(ip.gt.IMR) then
-      write(6,*) 'IC=',IC,' STEP=',NSTEP,
-     &           ' Vertical filling pts=',ip
-      endif
-C
-      if(sum.gt.1.e-25) then
-      write(6,*) IC,NSTEP,' Mass source from the ground=',sum
-      endif
-      RETURN
-      END
-C
-      subroutine filcr(q,IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
-      dimension q(IMR,*),cosp(*),acosp(*)
-      icr = 0
-      do 65 j=j1+1,j2-1
-      DO 50 i=1,IMR-1
-      IF(q(i,j).LT.0.) THEN
-      icr =  1
-      dq  = - q(i,j)*cosp(j)
-C N-E
-      dn = q(i+1,j+1)*cosp(j+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(i+1,j+1) = (dn - d1)*acosp(j+1)
-      dq = dq - d1
-C S-E
-      ds = q(i+1,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(i+1,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-50    continue
-      if(icr.eq.0 .and. q(IMR,j).ge.0.) goto 65
-      DO 55 i=2,IMR
-      IF(q(i,j).LT.0.) THEN
-      icr =  1
-      dq  = - q(i,j)*cosp(j)
-C N-W
-      dn = q(i-1,j+1)*cosp(j+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(i-1,j+1) = (dn - d1)*acosp(j+1)
-      dq = dq - d1
-C S-W
-      ds = q(i-1,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(i-1,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-55    continue
-C *****************************************
-C i=1
-      i=1
-      IF(q(i,j).LT.0.) THEN
-      icr =  1
-      dq  = - q(i,j)*cosp(j)
-C N-W
-      dn = q(IMR,j+1)*cosp(j+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(IMR,j+1) = (dn - d1)*acosp(j+1)
-      dq = dq - d1
-C S-W
-      ds = q(IMR,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(IMR,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-C *****************************************
-C i=IMR
-      i=IMR
-      IF(q(i,j).LT.0.) THEN
-      icr =  1
-      dq  = - q(i,j)*cosp(j)
-C N-E
-      dn = q(1,j+1)*cosp(j+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(1,j+1) = (dn - d1)*acosp(j+1)
-      dq = dq - d1
-C S-E
-      ds = q(1,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(1,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-C *****************************************
-65    continue
-C
-      do i=1,IMR
-      if(q(i,j1).lt.0. .or. q(i,j2).lt.0.) then
-      icr = 1
-      goto 80
-      endif
-      enddo
-C
-80    continue
-C
-      if(q(1,1).lt.0. .or. q(1,jnp).lt.0.) then
-      icr = 1
-      endif
-C
-      return
-      end
-C
-      subroutine filns(q,IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
-      dimension q(IMR,*),cosp(*),acosp(*)
-c      logical first
-c      data first /.true./
-c      save cap1
-C
-c      if(first) then
-      DP = 4.*ATAN(1.)/REAL(JNP-1)
-      CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
-c      first = .false.
-c      endif
-C
-      ipy = 0
-      do 55 j=j1+1,j2-1
-      DO 55 i=1,IMR
-      IF(q(i,j).LT.0.) THEN
-      ipy =  1
-      dq  = - q(i,j)*cosp(j)
-C North
-      dn = q(i,j+1)*cosp(j+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(i,j+1) = (dn - d1)*acosp(j+1)
-      dq = dq - d1
-C South
-      ds = q(i,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(i,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-55    continue
-C
-      do i=1,imr
-      IF(q(i,j1).LT.0.) THEN
-      ipy =  1
-      dq  = - q(i,j1)*cosp(j1)
-C North
-      dn = q(i,j1+1)*cosp(j1+1)
-      d0 = max(0.,dn)
-      d1 = min(dq,d0)
-      q(i,j1+1) = (dn - d1)*acosp(j1+1)
-      q(i,j1) = (d1 - dq)*acosp(j1) + tiny
-      endif
-      enddo
-C
-      j = j2
-      do i=1,imr
-      IF(q(i,j).LT.0.) THEN
-      ipy =  1
-      dq  = - q(i,j)*cosp(j)
-C South
-      ds = q(i,j-1)*cosp(j-1)
-      d0 = max(0.,ds)
-      d2 = min(dq,d0)
-      q(i,j-1) = (ds - d2)*acosp(j-1)
-      q(i,j) = (d2 - dq)*acosp(j) + tiny
-      endif
-      enddo
-C
-C Check Poles.
-      if(q(1,1).lt.0.) then
-      dq = q(1,1)*cap1/REAL(IMR)*acosp(j1)
-      do i=1,imr
-      q(i,1) = 0.
-      q(i,j1) = q(i,j1) + dq
-      if(q(i,j1).lt.0.) ipy = 1
-      enddo
-      endif
-C
-      if(q(1,JNP).lt.0.) then
-      dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2)
-      do i=1,imr
-      q(i,JNP) = 0.
-      q(i,j2) = q(i,j2) + dq
-      if(q(i,j2).lt.0.) ipy = 1
-      enddo
-      endif
-C
-      return
-      end
-C
-      subroutine filew(q,qtmp,IMR,JNP,j1,j2,ipx,tiny)
-      dimension q(IMR,*),qtmp(JNP,IMR)
-C
-      ipx = 0
-C Copy & swap direction for vectorization.
-      do 25 i=1,imr
-      do 25 j=j1,j2
-25    qtmp(j,i) = q(i,j)
-C
-      do 55 i=2,imr-1
-      do 55 j=j1,j2
-      if(qtmp(j,i).lt.0.) then
-      ipx =  1
-c west
-      d0 = max(0.,qtmp(j,i-1))
-      d1 = min(-qtmp(j,i),d0)
-      qtmp(j,i-1) = qtmp(j,i-1) - d1
-      qtmp(j,i) = qtmp(j,i) + d1
-c east
-      d0 = max(0.,qtmp(j,i+1))
-      d2 = min(-qtmp(j,i),d0)
-      qtmp(j,i+1) = qtmp(j,i+1) - d2
-      qtmp(j,i) = qtmp(j,i) + d2 + tiny
-      endif
-55    continue
-c
-      i=1
-      do 65 j=j1,j2
-      if(qtmp(j,i).lt.0.) then
-      ipx =  1
-c west
-      d0 = max(0.,qtmp(j,imr))
-      d1 = min(-qtmp(j,i),d0)
-      qtmp(j,imr) = qtmp(j,imr) - d1
-      qtmp(j,i) = qtmp(j,i) + d1
-c east
-      d0 = max(0.,qtmp(j,i+1))
-      d2 = min(-qtmp(j,i),d0)
-      qtmp(j,i+1) = qtmp(j,i+1) - d2
-c
-      qtmp(j,i) = qtmp(j,i) + d2 + tiny
-      endif
-65    continue
-      i=IMR
-      do 75 j=j1,j2
-      if(qtmp(j,i).lt.0.) then
-      ipx =  1
-c west
-      d0 = max(0.,qtmp(j,i-1))
-      d1 = min(-qtmp(j,i),d0)
-      qtmp(j,i-1) = qtmp(j,i-1) - d1
-      qtmp(j,i) = qtmp(j,i) + d1
-c east
-      d0 = max(0.,qtmp(j,1))
-      d2 = min(-qtmp(j,i),d0)
-      qtmp(j,1) = qtmp(j,1) - d2
-c
-      qtmp(j,i) = qtmp(j,i) + d2 + tiny
-      endif
-75    continue
-C
-      if(ipx.ne.0) then
-      do 85 j=j1,j2
-      do 85 i=1,imr
-85    q(i,j) = qtmp(j,i)
-      else
-C
-C Poles.
-      if(q(1,1).lt.0. or. q(1,JNP).lt.0.) ipx = 1
-      endif
-      return
-      end
-C
-      subroutine zflip(q,im,km,nc)
-C This routine flip the array q (in the vertical).
-      real q(im,km,nc)
-C local dynamic array
-      real qtmp(im,km)
-C
-      do 4000 IC = 1, nc
-C
-      do 1000 k=1,km
-      do 1000 i=1,im
-      qtmp(i,k) = q(i,km+1-k,IC)
-1000  continue
-C
-      do 2000 i=1,im*km
-2000  q(i,1,IC) = qtmp(i,1)
-4000  continue
-      return
-      end
Index: LMDZ5/branches/testing/libf/dyn3dmem/prather.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/prather.F	(revision 1910)
+++ 	(revision )
@@ -1,359 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE prather (q,w,masse,pbaru,pbarv,nt,dt)
-      IMPLICIT NONE
-
-c=======================================================================
-c   Adaptation LMDZ:  A.Armengaud (LGGE)
-c   ----------------
-c
-c   ************************************************
-c   Transport des traceurs par la methode de prather
-c   Ref : 
-c
-c   ************************************************
-c   q,w,pext,pbaru et pbarv : arguments d'entree  pour le s-pg
-c
-c=======================================================================
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-
-c   Arguments:
-c   ----------
-      INTEGER iq,nt
-      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm )
-      REAL masse(iip1,jjp1,llm)
-      REAL q( iip1,jjp1,llm,0:9)
-      REAL w( ip1jmp1,llm )
-      integer ordre,ilim
-
-c   Local:
-c   ------
-      LOGICAL limit
-      real zq(iip1,jjp1,llm)
-      REAL sm ( iip1,jjp1, llm )
-      REAL s0( iip1,jjp1,llm ),  sx( iip1,jjp1,llm )
-      REAL sy( iip1,jjp1,llm ),  sz( iip1,jjp1,llm )
-      REAL sxx( iip1,jjp1,llm)
-      REAL sxy( iip1,jjp1,llm)
-      REAL sxz( iip1,jjp1,llm)
-      REAL syy( iip1,jjp1,llm )
-      REAL syz( iip1,jjp1,llm )
-      REAL szz( iip1,jjp1,llm ),zz
-      INTEGER i,j,l,indice
-      real sxn(iip1),sxs(iip1)
-
-      real sinlon(iip1),sinlondlon(iip1)
-      real coslon(iip1),coslondlon(iip1)
-      real qmin,qmax
-      save qmin,qmax
-      save sinlon,coslon,sinlondlon,coslondlon
-      real dyn1,dyn2,dys1,dys2,qpn,qps,dqzpn,dqzps
-      real masn,mass
-c
-      REAL      SSUM
-      integer ismax,ismin
-      EXTERNAL  SSUM, ismin,ismax
-      logical first
-      save first
-
-      data first/.true./
-      data qmin,qmax/-1.e33,1.e33/
-
-
-c==========================================================================
-c==========================================================================
-c     MODIFICATION POUR PAS DE TEMPS ADAPTATIF, dtvr remplace par dt
-c==========================================================================
-c==========================================================================
-      REAL dt
-c==========================================================================
-      limit = .TRUE.
- 
-      if(first) then
-         print*,'SCHEMA PRATHER'
-         first=.false.
-         do i=2,iip1
-            coslon(i)=cos(rlonv(i))
-            sinlon(i)=sin(rlonv(i))
-            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
-            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
-         enddo
-         coslon(1)=coslon(iip1)
-         coslondlon(1)=coslondlon(iip1)
-         sinlon(1)=sinlon(iip1)
-         sinlondlon(1)=sinlondlon(iip1)
-
-        DO l = 1,llm
-        DO j = 1,jjp1
-        DO i = 1,iip1
-        q( i,j,l,1 )=0.
-        q( i,j,l,2)=0.
-        q( i,j,l,3)=0.
-        q( i,j,l,4)=0.
-        q( i,j,l,5)=0.
-        q( i,j,l,6)=0.
-        q( i,j,l,7)=0.
-        q( i,j,l,8)=0.
-        q( i,j,l,9)=0.
-        ENDDO
-        ENDDO
-        ENDDO
-      endif
-c   Fin modif Fred
-
-c *** On calcule la masse d'air en kg
-
-       DO l = 1,llm
-        DO j = 1,jjp1
-         DO i = 1,iip1
-         sm( i,j,llm+1-l ) =masse(i,j,l)
-         ENDDO
-        ENDDO
-       ENDDO
-
-c *** q contient les qqtes de traceur avant l'advection 
-
-c *** Affectation des tableaux S a partir de Q
- 
-       DO l = 1,llm
-        DO j = 1,jjp1
-         DO i = 1,iip1
-       s0( i,j,l) = q ( i,j,llm+1-l,0 )*sm(i,j,l)
-       sx( i,j,l) = q( i,j,llm+1-l,1 )*sm(i,j,l)
-       sy( i,j,l) = q( i,j,llm+1-l,2)*sm(i,j,l)
-       sz( i,j,l) = q( i,j,llm+1-l,3)*sm(i,j,l)
-       sxx( i,j,l) = q( i,j,llm+1-l,4)*sm(i,j,l)
-       sxy( i,j,l) = q( i,j,llm+1-l,5)*sm(i,j,l)
-       sxz( i,j,l) = q( i,j,llm+1-l,6)*sm(i,j,l)
-       syy( i,j,l) = q( i,j,llm+1-l,7)*sm(i,j,l)
-       syz( i,j,l) = q( i,j,llm+1-l,8)*sm(i,j,l)
-       szz( i,j,l) = q( i,j,llm+1-l,9)*sm(i,j,l)
-         ENDDO
-        ENDDO
-       ENDDO
-c *** Appel des subroutines d'advection en X, en Y et en Z
-c *** Advection avec "time-splitting"
-      
-c-----------------------------------------------------------
-       do indice =1,nt
-       call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
-     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
-        end do
-        do l=1,llm
-        do i=1,iip1
-        sy(i,1,l)=0.
-        sy(i,jjp1,l)=0.
-        enddo
-        enddo
-c---------------------------------------------------------
-       call advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
-     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
-c---------------------------------------------------------
-
-c---------------------------------------------------------
-       do j=1,jjp1
-          do i=1,iip1
-             sz(i,j,1)=0.
-             sz(i,j,llm)=0.
-             sxz(i,j,1)=0.
-             sxz(i,j,llm)=0.
-             syz(i,j,1)=0.
-             syz(i,j,llm)=0.
-             szz(i,j,1)=0.
-             szz(i,j,llm)=0.
-          enddo
-       enddo
-       call advzp( limit,dt*nt,w,sm,s0,sx,sy,sz 
-     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
-        do l=1,llm
-        do i=1,iip1
-        sy(i,1,l)=0.
-        sy(i,jjp1,l)=0.
-        enddo
-        enddo
-
-c---------------------------------------------------------
-
-c---------------------------------------------------------
-       call advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
-     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
-c---------------------------------------------------------
-       DO l = 1,llm
-        DO j = 1,jjp1
-             s0( iip1,j,l)=s0( 1,j,l )
-             sx( iip1,j,l)=sx( 1,j,l )
-             sy( iip1,j,l)=sy( 1,j,l )
-             sz( iip1,j,l)=sz( 1,j,l )
-             sxx( iip1,j,l)=sxx( 1,j,l )
-             sxy( iip1,j,l)=sxy( 1,j,l) 
-             sxz( iip1,j,l)=sxz( 1,j,l )
-             syy( iip1,j,l)=syy( 1,j,l )
-             syz( iip1,j,l)=syz( 1,j,l)
-             szz( iip1,j,l)=szz( 1,j,l )
-        ENDDO
-       ENDDO
-       do indice=1,nt
-       call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
-     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
-        end do
-c---------------------------------------------------------
-c---------------------------------------------------------
-c ***   On repasse les S dans la variable qpr
-c ***   On repasse les S dans la variable q directement 14/10/94
-
-       DO  l = 1,llm
-        DO  j = 1,jjp1
-         DO  i = 1,iip1
-      q( i,j,llm+1-l,0 )=s0( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,1 ) = sx( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,2 ) = sy( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,3 ) = sz( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,4 ) = sxx( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,5 ) = sxy( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,6 ) = sxz( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,7 ) = syy( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,8 ) = syz( i,j,l )/sm(i,j,l)
-      q( i,j,llm+1-l,9 ) = szz( i,j,l )/sm(i,j,l)
-      ENDDO
-      ENDDO
-      ENDDO
-
-c---------------------------------------------------------
-c      go to  777
-c   filtrages aux poles
-
-c Traitements specifiques au pole
-
-c   filtrages aux poles
-         DO l=1,llm
-c   filtrages aux poles
-         masn=ssum(iim,sm(1,1,l),1)
-         mass=ssum(iim,sm(1,jjp1,l),1)
-         qpn=ssum(iim,s0(1,1,l),1)/masn
-         qps=ssum(iim,s0(1,jjp1,l),1)/mass
-         dqzpn=ssum(iim,sz(1,1,l),1)/masn
-         dqzps=ssum(iim,sz(1,jjp1,l),1)/mass
-         do i=1,iip1
-          q( i,1,llm+1-l,3)=dqzpn
-          q( i,jjp1,llm+1-l,3)=dqzps
-          q( i,1,llm+1-l,0)=qpn
-          q( i,jjp1,llm+1-l,0)=qps
-         enddo
-c       enddo
-c         print*,'qpn',qpn,'qps',qps
-c          print*,'dqzpn',dqzpn,'dqzps',dqzps
-c       enddo
-           dyn1=0.
-           dys1=0.
-           dyn2=0.
-           dys2=0.
-        do i=1,iim
-        zz=s0(i,2,l)/sm(i,2,l)-q(i,1,llm+1-l,0)
-        dyn1=dyn1+sinlondlon(i)*zz
-        dyn2=dyn2+coslondlon(i)*zz
-        zz=q(i,jjp1,llm+1-l,0)-s0(i,jjm,l)/sm(i,jjm,l)
-        dys1=dys1+sinlondlon(i)*zz
-        dys2=dys2+coslondlon(i)*zz
-        enddo
-         do i=1,iim
-         q(i,1,llm+1-l,2)=
-     $   (sinlon(i)*dyn1+coslon(i)*dyn2)/2.
-         q(i,1,llm+1-l,0)=q(i,1,llm+1-l,0)
-     $          +q(i,1,llm+1-l,2)
-         q(i,jjp1,llm+1-l,2)=
-     $   (sinlon(i)*dys1+coslon(i)*dys2)/2.
-         q(i,jjp1,llm+1-l,0)=q(i,jjp1,llm+1-l,0)
-     $      -q(i,jjp1,llm+1-l,2)
-         enddo
-      q(iip1,1,llm+1-l,0)=q(1,1,llm+1-l,0)
-      q(iip1,jjp1,llm+1-l,0)=q(1,jjp1,llm+1-l,0)
-      do i=1,iim
-      sxn(i)=q(i+1,1,llm+1-l,0)-q(i,1,llm+1-l,0)
-      sxs(i)=q(i+1,jjp1,llm+1-l,0)-q(i,jjp1,llm+1-l,0)
-      enddo
-      sxn(iip1)=sxn(1)
-      sxs(iip1)=sxs(1)
-      do i=1,iim
-      q(i+1,1,llm+1-l,1)=0.25*(sxn(i)+sxn(i+1))
-      q(i+1,jjp1,llm+1-l,1)=0.25*(sxs(i)+sxs(i+1))
-      END DO
-      q(1,1,llm+1-l,1)=q(iip1,1,llm+1-l,1)
-      q(1,jjp1,llm+1-l,1)=
-     $   q(iip1,jjp1,llm+1-l,1)
-        enddo
-         do l=1,llm
-           do i=1,iim
-            q( i,1,llm+1-l,4)=0.
-            q( i,jjp1,llm+1-l,4)=0.
-            q( i,1,llm+1-l,5)=0.
-            q( i,jjp1,llm+1-l,5)=0.
-            q( i,1,llm+1-l,6)=0.
-            q( i,jjp1,llm+1-l,6)=0.
-            q( i,1,llm+1-l,7)=0.
-            q( i,jjp1,llm+1-l,7)=0.
-            q( i,1,llm+1-l,8)=0.
-            q( i,jjp1,llm+1-l,8)=0.
-            q( i,1,llm+1-l,9)=0.
-            q( i,jjp1,llm+1-l,9)=0.
-          enddo
-         ENDDO
-
-777      continue
-c
-c   bouclage en longitude
-      do l=1,llm
-      do j=1,jjp1
-      q(iip1,j,l,0)=q(1,j,l,0)
-      q(iip1,j,llm+1-l,0)=q(1,j,llm+1-l,0)
-      q(iip1,j,llm+1-l,1)=q(1,j,llm+1-l,1)
-      q(iip1,j,llm+1-l,2)=q(1,j,llm+1-l,2)
-      q(iip1,j,llm+1-l,3)=q(1,j,llm+1-l,3)
-      q(iip1,j,llm+1-l,4)=q(1,j,llm+1-l,4)
-      q(iip1,j,llm+1-l,5)=q(1,j,llm+1-l,5)
-      q(iip1,j,llm+1-l,6)=q(1,j,llm+1-l,6)
-      q(iip1,j,llm+1-l,7)=q(1,j,llm+1-l,7)
-      q(iip1,j,llm+1-l,8)=q(1,j,llm+1-l,8)
-      q(iip1,j,llm+1-l,9)=q(1,j,llm+1-l,9)
-      enddo
-      enddo
-        DO l = 1,llm
-    	 DO j = 2,jjm
-           DO i = 1,iip1
-         IF (q(i,j,l,0).lt.0.)  THEN
-         PRINT*,'------------ BIP-----------' 
-         PRINT*,'S0(',i,j,l,')=',q(i,j,l,0),
-     $          q(i,j-1,l,0)
-         PRINT*,'SX(',i,j,l,')=',q(i,j,l,1)
-         PRINT*,'SY(',i,j,l,')=',q(i,j,l,2),
-     $   q(i,j-1,l,2)   
-         PRINT*,'SZ(',i,j,l,')=',q(i,j,l,3)
-c    		     PRINT*,' PBL EN SORTIE D'' ADVZP'
-                     q(i,j,l,0)=0.
-c                  STOP
-               ENDIF
-           ENDDO
-         ENDDO
-         do j=1,jjp1,jjm
-         do i=1,iip1
-               IF (q(i,j,l,0).lt.0.)  THEN
-               PRINT*,'------------ BIP 2-----------'
-         PRINT*,'S0(',i,j,l,')=',q(i,j,l,0)
-         PRINT*,'SX(',i,j,l,')=',q(i,j,l,1)
-         PRINT*,'SY(',i,j,l,')=',q(i,j,l,2)
-         PRINT*,'SZ(',i,j,l,')=',q(i,j,l,3)
-
-                     q(i,j,l,0)=0.
-c                  STOP
-               ENDIF
-         enddo
-         enddo
-        ENDDO
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/pres2lev_mod.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/pres2lev_mod.F90	(revision 1910)
+++ 	(revision )
@@ -1,80 +1,0 @@
-! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
-!
-MODULE pres2lev_mod
-
-CONTAINS 
-
-!******************************************************
-SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
-!
-! interpolation lineaire pour passer
-! a une nouvelle discretisation verticale pour
-! les variables de GCM
-! Francois Forget (01/1995)
-! MOdif remy roca 12/97 pour passer de pres2sig
-! Modif F.Codron 07/08 po en 3D
-!**********************************************************
-
-  IMPLICIT NONE
-
-!   Declarations:
-! ==============
-!
-!  ARGUMENTS
-!  """""""""
-  LOGICAL, INTENT(IN) :: ok_invertp
-  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
-  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
-  
-  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
-  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
-
-  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
-
-  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
-  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
-
-  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
-
-! Autres variables
-! """"""""""""""""
-  INTEGER ::  ln ,lo, k
-  REAL    :: coef
-
-
-! Inversion de l'ordre des niveaux verticaux
-  IF (ok_invertp) THEN
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lmo+1-lo)
-        zvaro(k,lo)=varo(k,lmo+1-lo)
-      ENDDO
-    ENDDO
-  ELSE
-    DO lo=1,lmo
-      DO k=1,ni*nj
-        zpo(k,lo)=po(k,lo)
-        zvaro(k,lo)=varo(k,lo)
-      ENDDO
-    ENDDO
-  ENDIF 
-
-  DO ln=1,lmn
-    DO lo=1,lmo-1
-      DO k=1,ni*nj
-        IF (pn(k,ln) >= zpo(k,1) ) THEN
-          varn(k,ln) = zvaro(k,1)
-        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
-          varn(k,ln) = zvaro(k,lmo)
-        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
-          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
-          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
-        ENDIF
-         
-      ENDDO  
-    ENDDO
-  ENDDO                
-
-END SUBROUTINE pres2lev    
-
-END MODULE pres2lev_mod
Index: LMDZ5/branches/testing/libf/dyn3dmem/pression.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/pression.F	(revision 1910)
+++ 	(revision )
@@ -1,32 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE pression( ngrid, ap, bp, ps, p )
-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 ) 
-      
-      DO    l    = 1, llmp1
-        DO  ij   = 1, ngrid
-         p(ij,l) = ap(l) + bp(l) * ps(ij)
-        ENDDO
-      ENDDO
-   
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/pression_loc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/pression_loc.F	(revision 1910)
+++ LMDZ5/branches/testing/libf/dyn3dmem/pression_loc.F	(revision 1999)
@@ -1,4 +1,5 @@
       SUBROUTINE pression_loc( ngrid, ap, bp, ps, p )
-      USE parallel_lmdz
+      USE parallel_lmdz, ONLY: ij_begin, ij_end, ijb_u, ije_u,
+     &                         pole_nord, pole_sud, omp_chunk
 c
 
@@ -16,9 +17,9 @@
 #include "paramet.h"
 c
-      INTEGER ngrid
+      INTEGER,INTENT(IN) :: ngrid ! not used
       INTEGER l,ij
  
-      REAL ap( llmp1 ), bp( llmp1 ), ps( ijb_u:ije_u )
-      REAL p( ijb_u:ije_u,llmp1 ) 
+      REAL,INTENT(IN) :: ap( llmp1 ), bp( llmp1 ), ps( ijb_u:ije_u )
+      REAL,INTENT(OUT) :: p( ijb_u:ije_u,llmp1 ) 
       
       INTEGER ijb,ije
Index: LMDZ5/branches/testing/libf/dyn3dmem/profvert.def
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/profvert.def	(revision 1910)
+++ 	(revision )
@@ -1,23 +1,0 @@
-!
-! $Header$
-!
-nom_courbes=F
-titre=/home/hourdin/LMDZ4/libf/dyn3d
-xinf=0.
-xsup=669.
-yinf=6.5
-ysup=10.5
-axtxtx=sols
-axtxty=pressure (mb)
-pathcham=.
-lstyles=1 9999
-linewidth=.2
-lcolors=1 9999
-frwidth=.5
-repery0=T
-txtheight=2.5
-freecoord=/d2/hourdin/Ames/saison.def
-
-determination du champ physique
-xlength=195.
-ylength=105.
Index: LMDZ5/branches/testing/libf/dyn3dmem/psextbar.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/psextbar.F	(revision 1910)
+++ 	(revision )
@@ -1,107 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE psextbar ( ps, psexbarxy )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c **********************************************************************
-c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
-c **********************************************************************
-c
-c         ps          est un  argum. d'entree  pour le s-pg ..
-c         psexbarxy   est un  argum. de sortie pour le s-pg ..
-c
-c   Methode:
-c   --------
-c
-c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
-c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
-c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
-c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
-c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
-c
-c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)        
-c
-c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
-c
-c
-c
-c   alpha4 .         . alpha1    . alpha4
-c    (i,j)             (i,j)       (i+1,j)
-c
-c             P .        U .          . P
-c           (i,j)       (i,j)         (i+1,j)
-c
-c   alpha3 .         . alpha2    .alpha3 
-c    (i,j)              (i,j)     (i+1,j)
-c
-c             V .        Z .          . V
-c           (i,j)
-c
-c   alpha4 .         . alpha1    .alpha4
-c   (i,j+1)            (i,j+1)   (i+1,j+1) 
-c
-c             P .        U .          . P
-c          (i,j+1)                    (i+1,j+1)
-c
-c
-c
-c
-c                       On  a :
-c
-c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
-c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
-c     localise  au point  ... U (i,j) ...
-c
-c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
-c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)  
-c     localise  au point  ... V (i,j) ...
-c
-c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
-c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
-c     localise  au point  ... Z (i,j) ...
-c
-c
-c
-c=======================================================================
-
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-
-      REAL ps( ip1jmp1 ), psexbarxy ( ip1jm ), pext( ip1jmp1 )
-
-      INTEGER  l, ij
-c
-
-      DO ij = 1, ip1jmp1
-       pext(ij) = ps(ij) * aire(ij)
-      ENDDO
-
-
-      DO     5     ij = 1, ip1jm - 1
-      psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
-     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
-   5  CONTINUE
-
-
-c    ....  correction pour     psexbarxy( iip1,j )  ........
-
-CDIR$ IVDEP
-
-      DO 7 ij = iip1, ip1jm, iip1
-      psexbarxy( ij ) = psexbarxy( ij - iim )
-   7  CONTINUE
-
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/q_sat.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/q_sat.F	(revision 1910)
+++ 	(revision )
@@ -1,72 +1,0 @@
-!
-! $Header$
-!
-c
-c
-
-      subroutine q_sat(np,temp,pres,qsat)
-c
-      IMPLICIT none
-c======================================================================
-c Autheur(s): Z.X. Li (LMD/CNRS)
-c  reecriture vectorisee par F. Hourdin.
-c Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
-c======================================================================
-c Arguments:
-c kelvin---input-R: temperature en Kelvin
-c millibar--input-R: pression en mb
-c
-c q_sat----output-R: vapeur d'eau saturante en kg/kg
-c======================================================================
-c
-      integer np
-      REAL temp(np),pres(np),qsat(np)
-c
-      REAL r2es
-      PARAMETER (r2es=611.14 *18.0153/28.9644)
-c
-      REAL r3les, r3ies, r3es
-      PARAMETER (R3LES=17.269)
-      PARAMETER (R3IES=21.875)
-c
-      REAL r4les, r4ies, r4es
-      PARAMETER (R4LES=35.86)
-      PARAMETER (R4IES=7.66)
-c
-      REAL rtt
-      PARAMETER (rtt=273.16)
-c
-      REAL retv
-      PARAMETER (retv=28.9644/18.0153 - 1.0)
-
-      real zqsat
-      integer ip
-c
-C     ------------------------------------------------------------------
-c
-c
-
-      do ip=1,np
-
-c      write(*,*)'kelvin,millibar=',kelvin,millibar
-c       write(*,*)'temp,pres=',temp(ip),pres(ip)
-c
-         IF (temp(ip) .LE. rtt) THEN
-            r3es = r3ies
-            r4es = r4ies
-         ELSE
-            r3es = r3les
-            r4es = r4les
-         ENDIF
-c
-         zqsat=r2es/pres(ip)*EXP(r3es*(temp(ip)-rtt)/(temp(ip)-r4es))
-         zqsat=MIN(0.5,ZQSAT)
-         zqsat=zqsat/(1.-retv *zqsat)
-c
-         qsat(ip)= zqsat
-c      write(*,*)'qsat=',qsat(ip)
-
-      enddo
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/ran1.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ran1.F	(revision 1910)
+++ 	(revision )
@@ -1,34 +1,0 @@
-!
-! $Id: ran1.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      FUNCTION RAN1(IDUM)
-      DIMENSION R(97)
-      save r
-      save iff,ix1,ix2,ix3
-      PARAMETER (M1=259200,IA1=7141,IC1=54773,RM1=3.8580247E-6)
-      PARAMETER (M2=134456,IA2=8121,IC2=28411,RM2=7.4373773E-6)
-      PARAMETER (M3=243000,IA3=4561,IC3=51349)
-      DATA IFF /0/
-      IF (IDUM.LT.0.OR.IFF.EQ.0) THEN
-        IFF=1
-        IX1=MOD(IC1-IDUM,M1)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX2=MOD(IX1,M2)
-        IX1=MOD(IA1*IX1+IC1,M1)
-        IX3=MOD(IX1,M3)
-        DO 11 J=1,97
-          IX1=MOD(IA1*IX1+IC1,M1)
-          IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-11      CONTINUE
-        IDUM=1
-      ENDIF
-      IX1=MOD(IA1*IX1+IC1,M1)
-      IX2=MOD(IA2*IX2+IC2,M2)
-      IX3=MOD(IA3*IX3+IC3,M3)
-      J=1+(97*IX3)/M3
-      IF(J.GT.97.OR.J.LT.1)PAUSE
-      RAN1=R(J)
-      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/rotat.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/rotat.F	(revision 1910)
+++ 	(revision )
@@ -1,58 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE rotat (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
-      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
-c
-c
-      DO  10 l = 1,klevel
-c
-        DO   ij = 1, ip1jm - 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 = iip1, ip1jm, iip1
-         rot( ij,l ) = rot( ij -iim,l )
-        ENDDO
-c
-  10  CONTINUE
-
-ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
-      
-        DO l = 1, klevel
-          DO ij = 1, ip1jm
-           rot(ij,l) = rot(ij,l) * unsairez(ij)
-          ENDDO
-        ENDDO
-c
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/rotat_nfil.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/rotat_nfil.F	(revision 1910)
+++ 	(revision )
@@ -1,49 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE rotat_nfil (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
-      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
-c
-c
-      DO  10 l = 1,klevel
-c
-        DO   ij = 1, ip1jm - 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 = iip1, ip1jm, iip1
-         rot( ij,l ) = rot( ij -iim,l )
-        ENDDO
-c
-  10  CONTINUE
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/rotatf.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/rotatf.F	(revision 1910)
+++ 	(revision )
@@ -1,58 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE rotatf (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
-      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
-c
-c
-      DO  10 l = 1,klevel
-c
-        DO   ij = 1, ip1jm - 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 = iip1, ip1jm, iip1
-         rot( ij,l ) = rot( ij -iim,l )
-        ENDDO
-c
-  10  CONTINUE
-
-        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
-      
-        DO l = 1, klevel
-          DO ij = 1, ip1jm
-           rot(ij,l) = rot(ij,l) * unsairez(ij)
-          ENDDO
-        ENDDO
-c
-c
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/rotatst.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/rotatst.F	(revision 1910)
+++ 	(revision )
@@ -1,43 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE rotatst (klevel,x, y, rot )
-c
-c  P. Le Van
-c
-c    *****************************************************************
-c     .. calcule le rotationnel a tous les niveaux d'1 vecteur de comp. x et y ..
-c         x  et  y etant des composantes  covariantes  .....
-c    *****************************************************************
-c        x  et y     sont des arguments d'entree pour le s-prog
-c        rot          est  un argument  de sortie pour le s-prog
-c
-      IMPLICIT NONE
-c
-      INTEGER klevel
-#include "dimensions.h"
-#include "paramet.h"
-
-      REAL rot( ip1jm,klevel )
-      REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
-      INTEGER  l, ij
-c
-c
-      DO 5 l = 1,klevel
-c
-      DO 1 ij = 1, ip1jm - 1
-      rot( ij,l )  =  (  y( ij+1 , l )  -  y( ij,l )   +
-     *                 x(ij +iip1, l )  -  x( ij,l )  )
-   1  CONTINUE
-c
-c    .... correction pour rot( iip1,j,l)  ....
-c
-c    ....   rot(iip1,j,l)= rot(1,j,l) ...
-CDIR$ IVDEP
-      DO 2 ij = iip1, ip1jm, iip1
-      rot( ij,l ) = rot( ij -iim,l )
-   2  CONTINUE
-c
-   5  CONTINUE
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/serre.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/serre.h	(revision 1910)
+++ 	(revision )
@@ -1,11 +1,0 @@
-!
-! $Header$
-!
-!c
-!c
-!c..include serre.h
-!c
-       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
-     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
-       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
-     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: LMDZ5/branches/testing/libf/dyn3dmem/sort.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/sort.F	(revision 1910)
+++ 	(revision )
@@ -1,37 +1,0 @@
-!
-! $Header$
-!
-C
-C
-      SUBROUTINE sort(n,d)
-c
-c     P.Le Van
-c      
-c...  cette routine met le tableau d  dans l'ordre croissant  ....
-cc   ( pour avoir l'ordre decroissant,il suffit de remplacer l'instruc
-c      tion  situee + bas  IF(d(j).LE.p)  THEN     par
-c                           IF(d(j).GE.p)  THEN
-c
-
-      INTEGER n
-      REAL d(n) , p
-      INTEGER i,j,k
-
-      DO i=1,n-1
-        k=i
-        p=d(i)
-        DO j=i+1,n
-         IF(d(j).LE.p) THEN
-           k=j
-           p=d(j)
-         ENDIF
-        ENDDO
-
-       IF(k.ne.i) THEN
-         d(k)=d(i)
-         d(i)=p
-       ENDIF
-      ENDDO
-
-       RETURN
-       END
Index: LMDZ5/branches/testing/libf/dyn3dmem/sortvarc.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/sortvarc.F	(revision 1910)
+++ 	(revision )
@@ -1,166 +1,0 @@
-!
-! $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/branches/testing/libf/dyn3dmem/sortvarc0.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/sortvarc0.F	(revision 1910)
+++ 	(revision )
@@ -1,141 +1,0 @@
-!
-! $Id: sortvarc0.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE sortvarc0
-     $(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
-      integer  ismin,ismax
-
-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
-      ptot0  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
-      etot0  = SSUM(     llm, etotl, 1 )
-      ztot0  = SSUM(     llm, ztotl, 1 )
-      stot0  = SSUM(     llm, stotl, 1 )
-      rmsv   = SSUM(     llm, rmsvl, 1 )
-      ang0   = SSUM(     llm,  angl, 1 )
-
-      rday = REAL(INT (time ))
-c
-      PRINT 3500, itau, rday, heure, time
-      PRINT *, ptot0,etot0,ztot0,stot0,ang0
-
-3500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x 
-     *   ,'date',f10.5,4x,10("*"))
-      RETURN
-      END
-
Index: LMDZ5/branches/testing/libf/dyn3dmem/startvar.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/startvar.F90	(revision 1910)
+++ 	(revision )
@@ -1,783 +1,0 @@
-!
-! $Id: startvar.F90 1425 2010-09-02 13:45:23Z lguez $
-!
-!*******************************************************************************
-!
-MODULE startvar
-!
-!*******************************************************************************
-!
-!-------------------------------------------------------------------------------
-! Purpose: Access data from the database of atmospheric to initialize the model.
-!-------------------------------------------------------------------------------
-! Comments:
-!
-!    *  This module is designed to work for Earth (and with ioipsl)
-!
-!    *  There are three ways to acces data, depending on the type of field
-!  which needs to be extracted. In any case the call should come after a restget
-!  and should be of the type :                     CALL startget(...)
-!
-!  - A 1D variable on the physical grid :
-!    CALL startget_phys1d((varname, iml, jml,  lon_in,  lat_in,  nbindex,              &
-!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
-!
-!  - A 2D variable on the dynamical grid :
-!    CALL startget_phys2d(varname, iml, jml,  lon_in,  lat_in,                        &
-!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )             
-!
-!  - A 3D variable on the dynamical grid :
-!    CALL startget_dyn((varname, iml, jml,  lon_in,  lat_in,  lml, pls, workvar,    &
-!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
-!
-!    *  Data needs to be in NetCDF format
-!
-!    *  Variables should have the following names in the files:
-!            'RELIEF' : High resolution orography 
-!            'ST'     : Surface temperature
-!            'CDSW'   : Soil moisture
-!            'Z'      : Surface geopotential
-!            'SP'     : Surface pressure
-!            'U'      : East ward wind
-!            'V'      : Northward wind
-!            'TEMP'   : Temperature
-!            'R'      : Relative humidity
-!
-!   *   There is a big mess with the longitude size. Should it be iml or iml+1 ?
-!  I have chosen to use the iml+1 as an argument to this routine and we declare
-!  internaly smaller fields when needed. This needs to be cleared once and for
-!  all in LMDZ. A convention is required.
-!-------------------------------------------------------------------------------
-#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/branches/testing/libf/dyn3dmem/test_period.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/test_period.F	(revision 1910)
+++ 	(revision )
@@ -1,115 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
-      USE infotrac, ONLY : nqtot
-c
-c     Auteur : P. Le Van  
-c    ---------
-c  ....  Cette routine teste la periodicite en longitude des champs   ucov,
-c                           teta, q , p et phis                 .......... 
-c
-c     IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-c
-c    ......  Arguments   ......
-c
-      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
-     ,      q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
-c
-c   .....  Variables  locales  .....
-c
-      INTEGER ij,l,nq
-c
-      DO l = 1, llm
-         DO ij = 1, ip1jmp1, iip1
-          IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
-          PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas',  
-     ,  ' periodique en longitude ! '
-          PRINT *,' l,  ij = ', l, ij, ij+iim
-          STOP
-          ENDIF
-          IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
-          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas',  
-     ,   ' periodique en longitude ! '
-          PRINT *,' l,  ij = ', l, ij, ij+iim
-     ,      , teta(ij,l),   teta(ij+iim,l)
-          STOP
-          ENDIF
-         ENDDO
-
-         do ij=1,iim
-          if (teta(ij,l).ne.teta(1,l)
-     s     .or.teta(ip1jm+ij,l).ne.teta(ip1jm+1,l) ) then
-          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas',  
-     ,  ' constant aux poles ! '
-          print*,'teta(',1 ,',',l,')=',teta(1 ,l)
-          print*,'teta(',ij,',',l,')=',teta(ij,l)
-          print*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
-          print*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
-          stop
-          endif
-         enddo
-      ENDDO
-
-c
-      DO l = 1, llm
-         DO ij = 1, ip1jm, iip1
-          IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
-          PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas',  
-     ,   ' periodique en longitude !'
-          PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
-          vcov(ij+iim,l)=vcov(ij,l)
-c         STOP
-          ENDIF
-         ENDDO
-      ENDDO
-      
-c
-      DO nq =1, nqtot
-        DO l =1, llm
-          DO ij = 1, ip1jmp1, iip1
-          IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
-          PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ',  
-     ,   'periodique en longitude !'
-          PRINT *,' nq , l,  ij = ', nq, l, ij, ij+iim
-          STOP
-          ENDIF
-          ENDDO
-        ENDDO
-      ENDDO
-c
-       DO l = 1, llm
-         DO ij = 1, ip1jmp1, iip1
-          IF( p(ij,l).NE.p(ij+iim,l) )  THEN
-          PRINT *,'STOP dans test_period car ---  P  ---  n est pas',  
-     ,    ' periodique en longitude !'
-          PRINT *,' l ij = ',l, ij, ij+iim
-          STOP
-          ENDIF
-          IF( phis(ij).NE.phis(ij+iim) )  THEN
-          PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas',  
-     ,   ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
-          PRINT *,' ij = ', ij, ij+iim
-          STOP
-          ENDIF
-         ENDDO
-         do ij=1,iim
-          if (p(ij,l).ne.p(1,l)
-     s     .or.p(ip1jm+ij,l).ne.p(ip1jm+1,l) ) then
-          PRINT *,'STOP dans test_period car ---  P     ---  n est pas',  
-     ,  ' constant aux poles ! '
-          print*,'p(',1 ,',',l,')=',p(1 ,l)
-          print*,'p(',ij,',',l,')=',p(ij,l)
-          print*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
-          print*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
-          stop
-          endif
-         enddo
-       ENDDO
-c
-c
-         RETURN
-         END
Index: LMDZ5/branches/testing/libf/dyn3dmem/tourabs.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/tourabs.F	(revision 1910)
+++ 	(revision )
@@ -1,98 +1,0 @@
-      SUBROUTINE tourabs ( ntetaSTD,vcov, ucov, vorabs )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Modif:  I. Musat (28/10/04)
-c   -------
-c   adaptation du code tourpot.F pour le calcul de la vorticite absolue
-c   cf. P. Le Van
-c
-c   Objet: 
-c   ------
-c
-c    *******************************************************************
-c    .............  calcul de la vorticite absolue     .................
-c    *******************************************************************
-c
-c     ntetaSTD, vcov,ucov      sont des argum. d'entree pour le s-pg .
-c             vorabs            est  un argum.de sortie pour le s-pg .
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "comconst.h"
-c
-      INTEGER ntetaSTD
-      REAL vcov( ip1jm,ntetaSTD ), ucov( ip1jmp1,ntetaSTD )
-      REAL vorabs( ip1jm,ntetaSTD )
-c
-c variables locales
-      INTEGER l, ij, i, j
-      REAL  rot( ip1jm,ntetaSTD )
-
-
-
-c  ... vorabs = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) ..
-
-
-
-c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
-
-      DO 5 l = 1,ntetaSTD
-
-      DO 2 i = 1, iip1
-      DO 2 j = 1, jjm
-c
-       ij=i+(j-1)*iip1
-       IF(ij.LE.ip1jm - 1) THEN
-c
-        IF(cv(ij).EQ.0..OR.cv(ij+1).EQ.0..OR.
-     $     cu(ij).EQ.0..OR.cu(ij+iip1).EQ.0.) THEN
-         rot( ij,l ) = 0.
-         continue
-        ELSE
-         rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
-     $                 (2.*pi*RAD*cos(rlatv(j)))*REAL(iim)
-     $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
-     $                 (pi*RAD)*(REAL(jjm)-1.)
-c
-        ENDIF
-       ENDIF !(ij.LE.ip1jm - 1) THEN
-   2  CONTINUE
-
-c    ....  correction pour  rot( iip1,j,l )  .....
-c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
-
-CDIR$ IVDEP
-
-      DO 3 ij = iip1, ip1jm, iip1
-      rot( ij,l ) = rot( ij -iim, l )
-   3  CONTINUE
-
-   5  CONTINUE
-
-
-      CALL  filtreg( rot, jjm, ntetaSTD, 2, 1, .FALSE., 1 )
-
-
-      DO 10 l = 1, ntetaSTD
-
-      DO 6 ij = 1, ip1jm - 1
-      vorabs( ij,l ) = ( rot(ij,l) + fext(ij)*unsairez(ij) )
-   6  CONTINUE
-
-c    ..... correction pour  vorabs( iip1,j,l)  .....
-c    ....   vorabs(iip1,j,l)= vorabs(1,j,l) ....
-CDIR$ IVDEP
-      DO 8 ij = iip1, ip1jm, iip1
-      vorabs( ij,l ) = vorabs( ij -iim,l )
-   8  CONTINUE
-
-  10  CONTINUE
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/tourpot.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/tourpot.F	(revision 1910)
+++ 	(revision )
@@ -1,81 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE tourpot ( vcov, ucov, massebxy, vorpot )
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van
-c   -------
-c
-c   Objet:
-c   ------
-c
-c    *******************************************************************
-c    .........      calcul du tourbillon potentiel             .........
-c    *******************************************************************
-c
-c     vcov,ucov,fext et pbarxyfl sont des argum. d'entree pour le s-pg .
-c             vorpot            est  un argum.de sortie pour le s-pg .
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comgeom.h"
-#include "logic.h"
-
-      REAL  rot( ip1jm,llm )
-      REAL vcov( ip1jm,llm ),ucov( ip1jmp1,llm )
-      REAL massebxy( ip1jm,llm ),vorpot( ip1jm,llm )
-
-      INTEGER l, ij
-
-
-
-
-c  ... vorpot = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) /psbarxy ..
-
-
-
-c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
-
-      DO 5 l = 1,llm
-
-      DO 2 ij = 1, ip1jm - 1
-      rot( ij,l ) = vcov(ij+1,l)-vcov(ij,l)+ucov(ij+iip1,l)-ucov(ij,l)
-   2  CONTINUE
-
-c    ....  correction pour  rot( iip1,j,l )  .....
-c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
-
-CDIR$ IVDEP
-
-      DO 3 ij = iip1, ip1jm, iip1
-      rot( ij,l ) = rot( ij -iim, l )
-   3  CONTINUE
-
-   5  CONTINUE
-
-
-      CALL  filtreg( rot, jjm, llm, 2, 1, .FALSE., 1 )
-
-
-      DO 10 l = 1, llm
-
-      DO 6 ij = 1, ip1jm - 1
-      vorpot( ij,l ) = ( rot(ij,l) + fext(ij) ) / massebxy(ij,l)
-   6  CONTINUE
-
-c    ..... correction pour  vorpot( iip1,j,l)  .....
-c    ....   vorpot(iip1,j,l)= vorpot(1,j,l) ....
-CDIR$ IVDEP
-      DO 8 ij = iip1, ip1jm, iip1
-      vorpot( ij,l ) = vorpot( ij -iim,l )
-   8  CONTINUE
-
-  10  CONTINUE
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/traceurpole.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/traceurpole.F	(revision 1910)
+++ 	(revision )
@@ -1,70 +1,0 @@
-!
-! $Id: traceurpole.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-          subroutine traceurpole(q,masse)
-
-      USE control_mod
-
-          implicit none
-      
-#include "dimensions.h"
-c#include "paramr2.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissip.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-#include "ener.h"
-#include "description.h"
-
-
-c   Arguments
-       integer iq
-       real masse(iip1,jjp1,llm)
-       real q(iip1,jjp1,llm)
-       
-
-c   Locals
-      integer i,j,l
-      real sommemassen(llm)
-      real sommemqn(llm)
-      real sommemasses(llm)
-      real sommemqs(llm)
-      real qpolen(llm),qpoles(llm)
-
-    
-c On impose une seule valeur au pôle Sud j=jjm+1=jjp1       
-      sommemasses=0
-      sommemqs=0
-          do l=1,llm
-             do i=1,iip1          
-                 sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
-                 sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
-             enddo         
-          qpoles(l)=sommemqs(l)/sommemasses(l)
-          enddo
-
-c On impose une seule valeur du traceur au pôle Nord j=1
-      sommemassen=0
-      sommemqn=0  
-         do l=1,llm
-           do i=1,iip1              
-               sommemassen(l)=sommemassen(l)+masse(i,1,l)
-               sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
-           enddo
-           qpolen(l)=sommemqn(l)/sommemassen(l) 
-         enddo
-    
-c On force le traceur à prendre cette valeur aux pôles
-        do l=1,llm
-            do i=1,iip1
-               q(i,1,l)=qpolen(l)
-               q(i,jjp1,l)=qpoles(l)
-             enddo
-        enddo
-
-      
-      return
-      end           
Index: LMDZ5/branches/testing/libf/dyn3dmem/tracstoke.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/tracstoke.h	(revision 1910)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      common /tracstoke/istdyn,istphy,unittrac
-      integer istdyn,istphy,unittrac
Index: LMDZ5/branches/testing/libf/dyn3dmem/ugeostr.F90
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/ugeostr.F90	(revision 1910)
+++ 	(revision )
@@ -1,68 +1,0 @@
-!
-! $Id: ugeostr.F90 1492 2011-03-08 08:10:25Z fairhead $
-!
-subroutine ugeostr(phi,ucov)
-
-  ! Calcul du vent covariant geostrophique a partir du champ de
-  ! geopotentiel.
-  ! We actually compute: (1 - cos^8 \phi) u_g
-  ! to have a wind going smoothly to 0 at the equator.
-  ! We assume that the surface pressure is uniform so that model
-  ! levels are pressure levels.
-
-  implicit none
-
-  include "dimensions.h"
-  include "paramet.h"
-  include "comconst.h"
-  include "comgeom2.h"
-
-  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
-  real um(jjm,llm),fact,u(iip1,jjm,llm)
-  integer i,j,l
-
-  real zlat
-
-  um(:,:)=0 ! initialize um()
-
-  DO j=1,jjm
-
-     if (abs(sin(rlatv(j))).lt.1.e-4) then
-        zlat=1.e-4
-     else
-        zlat=rlatv(j)
-     endif
-     fact=cos(zlat)
-     fact=fact*fact
-     fact=fact*fact
-     fact=fact*fact
-     fact=(1.-fact)/ &
-          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
-     fact=-fact/rad
-     DO l=1,llm
-        DO i=1,iim
-           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
-        ENDDO
-     ENDDO
-  ENDDO
-  call dump2d(jjm,llm,um,'Vent-u geostrophique')
-
-  !   calcul des champ de vent:
-
-  DO l=1,llm
-     DO i=1,iip1
-        ucov(i,1,l)=0.
-        ucov(i,jjp1,l)=0.
-     end DO
-     DO  j=2,jjm
-        DO  i=1,iim
-           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
-        end DO
-        ucov(iip1,j,l)=ucov(1,j,l)
-     end DO
-  end DO
-
-  print *, 301
-
-end subroutine ugeostr
Index: LMDZ5/branches/testing/libf/dyn3dmem/vitvert.F
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/vitvert.F	(revision 1910)
+++ 	(revision )
@@ -1,52 +1,0 @@
-!
-! $Header$
-!
-      SUBROUTINE vitvert ( convm , w )
-c
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteurs:  P. Le Van , F. Hourdin .
-c   -------
-c
-c   Objet:
-c   ------
-c
-c    *******************************************************************
-c  .... calcul de la vitesse verticale aux niveaux sigma  ....
-c    *******************************************************************
-c     convm   est un argument  d'entree pour le s-pg  ......
-c       w     est un argument de sortie pour le s-pg  ......
-c
-c    la vitesse verticale est orientee de  haut en bas .
-c    au sol, au niveau sigma(1),   w(i,j,1) = 0.
-c    au sommet, au niveau sigma(llm+1) , la vit.verticale est aussi
-c    egale a 0. et n'est pas stockee dans le tableau w  .
-c
-c
-c=======================================================================
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-
-      REAL w(ip1jmp1,llm),convm(ip1jmp1,llm)
-      INTEGER   l, ij
-
-
-
-      DO 2  l = 1,llmm1
-
-      DO 1 ij = 1,ip1jmp1
-      w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 )
-   1  CONTINUE
-
-   2  CONTINUE
-
-      DO 5 ij  = 1,ip1jmp1
-      w(ij,1)  = 0.
-5     CONTINUE
-
-      RETURN
-      END
Index: LMDZ5/branches/testing/libf/dyn3dmem/write_grads_dyn.h
===================================================================
--- LMDZ5/branches/testing/libf/dyn3dmem/write_grads_dyn.h	(revision 1910)
+++ 	(revision )
@@ -1,31 +1,0 @@
-!
-! $Header$
-!
-      if (callinigrads) then
-
-         string10='dyn'
-         call inigrads(1,iip1
-     s  ,rlonv,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
-     s  ,llm,presnivs,1.
-     s  ,dtvr*iperiod,string10,'dyn_zon ')
-
-        callinigrads=.false.
-
-
-      endif
-
-      string10='ps'
-      CALL wrgrads(1,1,ps,string10,string10)
-
-      string10='u'
-      CALL wrgrads(1,llm,unat,string10,string10)
-      string10='v'
-      CALL wrgrads(1,llm,vnat,string10,string10)
-      string10='teta'
-      CALL wrgrads(1,llm,teta,string10,string10)
-      do iq=1,nqtot
-         string10='q'
-         write(string10(2:2),'(i1)') iq
-         CALL wrgrads(1,llm,q(:,:,iq),string10,string10)
-      enddo
-
