Index: DZ5/trunk/libf/dyn3d/PVtheta.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/PVtheta.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/advn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/advn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/advxp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/advxp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/advy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/advy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/advyp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/advyp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/advzp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/advzp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/bernoui.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/bernoui.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/caldyn0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/caldyn0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/clesph0.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/clesph0.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/coefpoly.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/coefpoly.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/com_io_dyn_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/com_io_dyn_mod.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/comdissip.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/comdissip.h	(revision 1944)
+++ 	(revision )
@@ -1,15 +1,0 @@
-!
-! $Header$
-!
-!-----------------------------------------------------------------------
-! INCLUDE comdissip.h
-
-      COMMON/comdissip/                                                 &
-     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
-
-
-      INTEGER niterdis
-
-      REAL tetavel,tetatemp,coefdis,gamdissip
-
-!-----------------------------------------------------------------------
Index: DZ5/trunk/libf/dyn3d/comgeom.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/comgeom.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/comgeom2.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/comgeom2.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/conf_dat2d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/conf_dat2d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/conf_dat3d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/conf_dat3d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/conf_planete.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/conf_planete.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/convflu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/convflu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/convmas.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/convmas.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/coordij.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/coordij.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/covcont.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/covcont.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/diverg.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/diverg.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/diverg_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/diverg_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/divergf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/divergf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/divergst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/divergst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/divgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/divgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/divgrad2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/divgrad2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/enercin.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/enercin.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/exner_milieu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/exner_milieu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/flumass.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/flumass.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/fxyhyper.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/fxyhyper.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/geopot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/geopot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_dyn_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_dyn_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_ecrit_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_ecrit_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_fi_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_fi_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_int_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_int_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_u_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_u_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gr_v_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gr_v_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/grad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/grad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gradiv.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gradiv.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gradiv2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gradiv2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/gradsdef.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/gradsdef.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/heavyside.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/heavyside.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/infotrac.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/infotrac.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/inigrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/inigrads.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/iniprint.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/iniprint.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/initial0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/initial0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/interpost.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/interpost.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/invert_lat.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/invert_lat.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/laplacien.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/laplacien.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/laplacien_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/laplacien_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/laplacien_rot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/laplacien_rot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/laplacien_rotgam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/laplacien_rotgam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/massbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/massbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/massbarxy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/massbarxy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/massdair.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/massdair.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/minmax.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/minmax.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/minmax2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/minmax2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/nxgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/nxgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/nxgrad_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/nxgrad_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/nxgradst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/nxgradst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/nxgraro2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/nxgraro2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/nxgrarot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/nxgrarot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/pbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/pbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/pression.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/pression.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/profvert.def
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/profvert.def	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/psextbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/psextbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/q_sat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/q_sat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/rotat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/rotat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/rotat_nfil.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/rotat_nfil.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/rotatf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/rotatf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/rotatst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/rotatst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/serre.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/serre.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/sort.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/sort.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/tourabs.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/tourabs.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/tourpot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/tourpot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/tracstoke.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/tracstoke.h	(revision 1944)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      common /tracstoke/istdyn,istphy,unittrac
-      integer istdyn,istphy,unittrac
Index: DZ5/trunk/libf/dyn3d/vitvert.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/vitvert.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3d/write_grads_dyn.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d/write_grads_dyn.h	(revision 1944)
+++ 	(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
-
Index: /LMDZ5/trunk/libf/dyn3d_common/PVtheta.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/PVtheta.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/PVtheta.F	(revision 1945)
@@ -0,0 +1,196 @@
+      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/trunk/libf/dyn3d_common/advn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/advn.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/advn.F	(revision 1945)
@@ -0,0 +1,983 @@
+!
+! $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/trunk/libf/dyn3d_common/advxp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/advxp.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/advxp.F	(revision 1945)
@@ -0,0 +1,650 @@
+!
+! $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/trunk/libf/dyn3d_common/advy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/advy.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/advy.F	(revision 1945)
@@ -0,0 +1,422 @@
+!
+! $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/trunk/libf/dyn3d_common/advyp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/advyp.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/advyp.F	(revision 1945)
@@ -0,0 +1,653 @@
+!
+! $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/trunk/libf/dyn3d_common/advzp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/advzp.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/advzp.F	(revision 1945)
@@ -0,0 +1,378 @@
+!
+! $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/trunk/libf/dyn3d_common/bernoui.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/bernoui.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/bernoui.F	(revision 1945)
@@ -0,0 +1,58 @@
+!
+! $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/trunk/libf/dyn3d_common/caldyn0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/caldyn0.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/caldyn0.F	(revision 1945)
@@ -0,0 +1,89 @@
+!
+! $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/trunk/libf/dyn3d_common/clesph0.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/clesph0.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/clesph0.h	(revision 1945)
@@ -0,0 +1,11 @@
+!
+! $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/trunk/libf/dyn3d_common/coefpoly.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/coefpoly.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/coefpoly.F	(revision 1945)
@@ -0,0 +1,40 @@
+!
+! $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/trunk/libf/dyn3d_common/com_io_dyn_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/com_io_dyn_mod.F90	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/com_io_dyn_mod.F90	(revision 1945)
@@ -0,0 +1,31 @@
+!
+! $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/trunk/libf/dyn3d_common/comdissip.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/comdissip.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/comdissip.h	(revision 1945)
@@ -0,0 +1,15 @@
+!
+! $Header$
+!
+!-----------------------------------------------------------------------
+! INCLUDE comdissip.h
+
+      COMMON/comdissip/                                                 &
+     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
+
+
+      INTEGER niterdis
+
+      REAL tetavel,tetatemp,coefdis,gamdissip
+
+!-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3d_common/comgeom.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/comgeom.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/comgeom.h	(revision 1945)
@@ -0,0 +1,33 @@
+!
+! $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/trunk/libf/dyn3d_common/comgeom2.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/comgeom2.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/comgeom2.h	(revision 1945)
@@ -0,0 +1,33 @@
+!
+! $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/trunk/libf/dyn3d_common/conf_dat2d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/conf_dat2d.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/conf_dat2d.F	(revision 1945)
@@ -0,0 +1,221 @@
+!
+! $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/trunk/libf/dyn3d_common/conf_dat3d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/conf_dat3d.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/conf_dat3d.F	(revision 1945)
@@ -0,0 +1,296 @@
+!
+! $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/trunk/libf/dyn3d_common/conf_planete.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/conf_planete.F90	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/conf_planete.F90	(revision 1945)
@@ -0,0 +1,70 @@
+!
+! $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/trunk/libf/dyn3d_common/convflu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/convflu.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/convflu.F	(revision 1945)
@@ -0,0 +1,62 @@
+!
+! $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/trunk/libf/dyn3d_common/convmas.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/convmas.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/convmas.F	(revision 1945)
@@ -0,0 +1,63 @@
+!
+! $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/trunk/libf/dyn3d_common/coordij.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/coordij.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/coordij.F	(revision 1945)
@@ -0,0 +1,48 @@
+!
+! $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/trunk/libf/dyn3d_common/covcont.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/covcont.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/covcont.F	(revision 1945)
@@ -0,0 +1,43 @@
+!
+! $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/trunk/libf/dyn3d_common/diverg.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/diverg.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/diverg.F	(revision 1945)
@@ -0,0 +1,85 @@
+!
+! $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/trunk/libf/dyn3d_common/diverg_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/diverg_gam.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/diverg_gam.F	(revision 1945)
@@ -0,0 +1,80 @@
+!
+! $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/trunk/libf/dyn3d_common/divergf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/divergf.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/divergf.F	(revision 1945)
@@ -0,0 +1,85 @@
+!
+! $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/trunk/libf/dyn3d_common/divergst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/divergst.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/divergst.F	(revision 1945)
@@ -0,0 +1,62 @@
+!
+! $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/trunk/libf/dyn3d_common/divgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/divgrad.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/divgrad.F	(revision 1945)
@@ -0,0 +1,56 @@
+!
+! $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/trunk/libf/dyn3d_common/divgrad2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/divgrad2.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/divgrad2.F	(revision 1945)
@@ -0,0 +1,79 @@
+!
+! $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/trunk/libf/dyn3d_common/enercin.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/enercin.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/enercin.F	(revision 1945)
@@ -0,0 +1,98 @@
+!
+! $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/trunk/libf/dyn3d_common/exner_milieu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/exner_milieu.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/exner_milieu.F	(revision 1945)
@@ -0,0 +1,144 @@
+!
+! $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/trunk/libf/dyn3d_common/flumass.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/flumass.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/flumass.F	(revision 1945)
@@ -0,0 +1,109 @@
+!
+! $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/trunk/libf/dyn3d_common/fxyhyper.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/fxyhyper.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/fxyhyper.F	(revision 1945)
@@ -0,0 +1,139 @@
+!
+! $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/trunk/libf/dyn3d_common/geopot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/geopot.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/geopot.F	(revision 1945)
@@ -0,0 +1,64 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_dyn_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_dyn_fi.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_dyn_fi.F	(revision 1945)
@@ -0,0 +1,38 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_ecrit_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_ecrit_fi.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_ecrit_fi.F	(revision 1945)
@@ -0,0 +1,32 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_fi_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_fi_dyn.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_fi_dyn.F	(revision 1945)
@@ -0,0 +1,40 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_int_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_int_dyn.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_int_dyn.F	(revision 1945)
@@ -0,0 +1,49 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_u_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_u_scal.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_u_scal.F	(revision 1945)
@@ -0,0 +1,60 @@
+!
+! $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/trunk/libf/dyn3d_common/gr_v_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gr_v_scal.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gr_v_scal.F	(revision 1945)
@@ -0,0 +1,64 @@
+!
+! $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/trunk/libf/dyn3d_common/grad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/grad.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/grad.F	(revision 1945)
@@ -0,0 +1,44 @@
+!
+! $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/trunk/libf/dyn3d_common/gradiv.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gradiv.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gradiv.F	(revision 1945)
@@ -0,0 +1,57 @@
+!
+! $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/trunk/libf/dyn3d_common/gradiv2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gradiv2.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gradiv2.F	(revision 1945)
@@ -0,0 +1,79 @@
+!
+! $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/trunk/libf/dyn3d_common/gradsdef.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/gradsdef.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/gradsdef.h	(revision 1945)
@@ -0,0 +1,23 @@
+!
+! $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/trunk/libf/dyn3d_common/heavyside.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/heavyside.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/heavyside.F	(revision 1945)
@@ -0,0 +1,23 @@
+!
+! $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/trunk/libf/dyn3d_common/infotrac.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/infotrac.F90	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/infotrac.F90	(revision 1945)
@@ -0,0 +1,390 @@
+! $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/trunk/libf/dyn3d_common/inigrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/inigrads.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/inigrads.F	(revision 1945)
@@ -0,0 +1,93 @@
+!
+! $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/trunk/libf/dyn3d_common/iniprint.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/iniprint.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/iniprint.h	(revision 1945)
@@ -0,0 +1,11 @@
+!
+! $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/trunk/libf/dyn3d_common/initial0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/initial0.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/initial0.F	(revision 1945)
@@ -0,0 +1,12 @@
+!
+! $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/trunk/libf/dyn3d_common/interpost.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/interpost.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/interpost.F	(revision 1945)
@@ -0,0 +1,45 @@
+!
+! $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/trunk/libf/dyn3d_common/invert_lat.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/invert_lat.F90	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/invert_lat.F90	(revision 1945)
@@ -0,0 +1,21 @@
+
+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/trunk/libf/dyn3d_common/laplacien.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/laplacien.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/laplacien.F	(revision 1945)
@@ -0,0 +1,40 @@
+!
+! $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/trunk/libf/dyn3d_common/laplacien_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/laplacien_gam.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/laplacien_gam.F	(revision 1945)
@@ -0,0 +1,53 @@
+!
+! $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/trunk/libf/dyn3d_common/laplacien_rot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/laplacien_rot.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/laplacien_rot.F	(revision 1945)
@@ -0,0 +1,39 @@
+!
+! $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/trunk/libf/dyn3d_common/laplacien_rotgam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/laplacien_rotgam.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/laplacien_rotgam.F	(revision 1945)
@@ -0,0 +1,44 @@
+!
+! $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/trunk/libf/dyn3d_common/massbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/massbar.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/massbar.F	(revision 1945)
@@ -0,0 +1,100 @@
+!
+! $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/trunk/libf/dyn3d_common/massbarxy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/massbarxy.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/massbarxy.F	(revision 1945)
@@ -0,0 +1,47 @@
+!
+! $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/trunk/libf/dyn3d_common/massdair.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/massdair.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/massdair.F	(revision 1945)
@@ -0,0 +1,109 @@
+!
+! $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/trunk/libf/dyn3d_common/minmax.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/minmax.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/minmax.F	(revision 1945)
@@ -0,0 +1,23 @@
+!
+! $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/trunk/libf/dyn3d_common/minmax2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/minmax2.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/minmax2.F	(revision 1945)
@@ -0,0 +1,20 @@
+!
+! $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/trunk/libf/dyn3d_common/nxgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/nxgrad.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/nxgrad.F	(revision 1945)
@@ -0,0 +1,48 @@
+!
+! $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/trunk/libf/dyn3d_common/nxgrad_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/nxgrad_gam.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/nxgrad_gam.F	(revision 1945)
@@ -0,0 +1,47 @@
+!
+! $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/trunk/libf/dyn3d_common/nxgradst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/nxgradst.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/nxgradst.F	(revision 1945)
@@ -0,0 +1,47 @@
+!
+! $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/trunk/libf/dyn3d_common/nxgraro2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/nxgraro2.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/nxgraro2.F	(revision 1945)
@@ -0,0 +1,68 @@
+!
+! $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/trunk/libf/dyn3d_common/nxgrarot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/nxgrarot.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/nxgrarot.F	(revision 1945)
@@ -0,0 +1,55 @@
+!
+! $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/trunk/libf/dyn3d_common/pbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/pbar.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/pbar.F	(revision 1945)
@@ -0,0 +1,124 @@
+!
+! $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/trunk/libf/dyn3d_common/pression.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/pression.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/pression.F	(revision 1945)
@@ -0,0 +1,32 @@
+!
+! $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/trunk/libf/dyn3d_common/profvert.def
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/profvert.def	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/profvert.def	(revision 1945)
@@ -0,0 +1,23 @@
+!
+! $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/trunk/libf/dyn3d_common/psextbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/psextbar.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/psextbar.F	(revision 1945)
@@ -0,0 +1,107 @@
+!
+! $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/trunk/libf/dyn3d_common/q_sat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/q_sat.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/q_sat.F	(revision 1945)
@@ -0,0 +1,72 @@
+!
+! $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/trunk/libf/dyn3d_common/rotat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/rotat.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/rotat.F	(revision 1945)
@@ -0,0 +1,58 @@
+!
+! $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/trunk/libf/dyn3d_common/rotat_nfil.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/rotat_nfil.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/rotat_nfil.F	(revision 1945)
@@ -0,0 +1,49 @@
+!
+! $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/trunk/libf/dyn3d_common/rotatf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/rotatf.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/rotatf.F	(revision 1945)
@@ -0,0 +1,58 @@
+!
+! $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/trunk/libf/dyn3d_common/rotatst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/rotatst.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/rotatst.F	(revision 1945)
@@ -0,0 +1,43 @@
+!
+! $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/trunk/libf/dyn3d_common/serre.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/serre.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/serre.h	(revision 1945)
@@ -0,0 +1,11 @@
+!
+! $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/trunk/libf/dyn3d_common/sort.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/sort.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/sort.F	(revision 1945)
@@ -0,0 +1,37 @@
+!
+! $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/trunk/libf/dyn3d_common/tourabs.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/tourabs.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/tourabs.F	(revision 1945)
@@ -0,0 +1,98 @@
+      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/trunk/libf/dyn3d_common/tourpot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/tourpot.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/tourpot.F	(revision 1945)
@@ -0,0 +1,81 @@
+!
+! $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/trunk/libf/dyn3d_common/tracstoke.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/tracstoke.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/tracstoke.h	(revision 1945)
@@ -0,0 +1,5 @@
+!
+! $Header$
+!
+      common /tracstoke/istdyn,istphy,unittrac
+      integer istdyn,istphy,unittrac
Index: /LMDZ5/trunk/libf/dyn3d_common/vitvert.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/vitvert.F	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/vitvert.F	(revision 1945)
@@ -0,0 +1,52 @@
+!
+! $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/trunk/libf/dyn3d_common/write_grads_dyn.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3d_common/write_grads_dyn.h	(revision 1945)
+++ /LMDZ5/trunk/libf/dyn3d_common/write_grads_dyn.h	(revision 1945)
@@ -0,0 +1,31 @@
+!
+! $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
+
Index: DZ5/trunk/libf/dyn3dmem/PVtheta.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/PVtheta.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/advn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/advxp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advxp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/advy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/advyp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advyp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/advzp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advzp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/bernoui.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/bernoui.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/caldyn0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/caldyn0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/clesph0.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/clesph0.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/coefpoly.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/coefpoly.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/com_io_dyn_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/com_io_dyn_mod.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/comdissip.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comdissip.h	(revision 1944)
+++ 	(revision )
@@ -1,15 +1,0 @@
-!
-! $Header$
-!
-!-----------------------------------------------------------------------
-! INCLUDE comdissip.h
-
-      COMMON/comdissip/                                                 &
-     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
-
-
-      INTEGER niterdis
-
-      REAL tetavel,tetatemp,coefdis,gamdissip
-
-!-----------------------------------------------------------------------
Index: DZ5/trunk/libf/dyn3dmem/comgeom.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comgeom.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/comgeom2.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comgeom2.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/conf_dat2d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/conf_dat2d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/conf_dat3d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/conf_dat3d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/conf_planete.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/conf_planete.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/convflu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/convflu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/convmas.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/convmas.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/coordij.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/coordij.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/covcont.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/covcont.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/diverg.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/diverg.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/diverg_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/diverg_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/divergf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/divergf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/divergst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/divergst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/divgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/divgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/divgrad2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/divgrad2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/enercin.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/enercin.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/exner_milieu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/exner_milieu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/flumass.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/flumass.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/fxyhyper.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/fxyhyper.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/geopot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/geopot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_dyn_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_dyn_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_ecrit_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_ecrit_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_fi_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_fi_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_int_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_int_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_u_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_u_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gr_v_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_v_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/grad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/grad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gradiv.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gradiv.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gradiv2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gradiv2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/gradsdef.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gradsdef.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/heavyside.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/heavyside.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/infotrac.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/infotrac.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/inigrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/inigrads.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/iniprint.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/iniprint.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/initial0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/initial0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/interpost.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/interpost.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/invert_lat.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/invert_lat.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/laplacien.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/laplacien.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/laplacien_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/laplacien_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/laplacien_rot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/laplacien_rot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/laplacien_rotgam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/laplacien_rotgam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/massbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/massbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/massbarxy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/massbarxy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/massdair.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/massdair.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/minmax.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/minmax.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/minmax2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/minmax2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/nxgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/nxgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/nxgrad_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/nxgrad_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/nxgradst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/nxgradst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/nxgraro2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/nxgraro2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/nxgrarot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/nxgrarot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/pbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/pbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/pression.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/pression.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/profvert.def
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/profvert.def	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/psextbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/psextbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/q_sat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/q_sat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/rotat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/rotat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/rotat_nfil.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/rotat_nfil.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/rotatf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/rotatf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/rotatst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/rotatst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/serre.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/serre.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/sort.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/sort.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/tourabs.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/tourabs.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/tourpot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/tourpot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/tracstoke.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/tracstoke.h	(revision 1944)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      common /tracstoke/istdyn,istphy,unittrac
-      integer istdyn,istphy,unittrac
Index: DZ5/trunk/libf/dyn3dmem/vitvert.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/vitvert.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dmem/write_grads_dyn.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/write_grads_dyn.h	(revision 1944)
+++ 	(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
-
Index: DZ5/trunk/libf/dyn3dpar/PVtheta.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/PVtheta.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/advn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/advn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/advxp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/advxp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/advy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/advy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/advyp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/advyp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/advzp.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/advzp.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/bernoui.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/bernoui.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/caldyn0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/caldyn0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/clesph0.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/clesph0.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/coefpoly.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/coefpoly.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/com_io_dyn_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/com_io_dyn_mod.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/comdissip.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/comdissip.h	(revision 1944)
+++ 	(revision )
@@ -1,15 +1,0 @@
-!
-! $Header$
-!
-!-----------------------------------------------------------------------
-! INCLUDE comdissip.h
-
-      COMMON/comdissip/                                                 &
-     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
-
-
-      INTEGER niterdis
-
-      REAL tetavel,tetatemp,coefdis,gamdissip
-
-!-----------------------------------------------------------------------
Index: DZ5/trunk/libf/dyn3dpar/comgeom.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/comgeom.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/comgeom2.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/comgeom2.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/conf_dat2d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/conf_dat2d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/conf_dat3d.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/conf_dat3d.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/conf_planete.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/conf_planete.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/convflu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/convflu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/convmas.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/convmas.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/coordij.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/coordij.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/covcont.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/covcont.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/diverg.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/diverg.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/diverg_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/diverg_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/divergf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/divergf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/divergst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/divergst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/divgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/divgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/divgrad2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/divgrad2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/enercin.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/enercin.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/exner_milieu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/exner_milieu.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/flumass.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/flumass.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/fxyhyper.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/fxyhyper.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/geopot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/geopot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_dyn_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_dyn_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_ecrit_fi.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_ecrit_fi.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_fi_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_fi_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_int_dyn.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_int_dyn.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_u_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_u_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gr_v_scal.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gr_v_scal.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/grad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/grad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gradiv.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gradiv.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gradiv2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gradiv2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/gradsdef.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/gradsdef.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/heavyside.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/heavyside.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/infotrac.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/infotrac.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/inigrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/inigrads.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/iniprint.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/iniprint.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/initial0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/initial0.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/interpost.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/interpost.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/invert_lat.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/invert_lat.F90	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/laplacien.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/laplacien.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/laplacien_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/laplacien_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/laplacien_rot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/laplacien_rot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/laplacien_rotgam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/laplacien_rotgam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/massbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/massbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/massbarxy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/massbarxy.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/massdair.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/massdair.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/minmax.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/minmax.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/minmax2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/minmax2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/nxgrad.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/nxgrad.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/nxgrad_gam.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/nxgrad_gam.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/nxgradst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/nxgradst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/nxgraro2.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/nxgraro2.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/nxgrarot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/nxgrarot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/pbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/pbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/pression.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/pression.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/profvert.def
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/profvert.def	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/psextbar.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/psextbar.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/q_sat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/q_sat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/rotat.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/rotat.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/rotat_nfil.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/rotat_nfil.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/rotatf.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/rotatf.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/rotatst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/rotatst.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/serre.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/serre.h	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/sort.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/sort.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/tourabs.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/tourabs.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/tourpot.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/tourpot.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/tracstoke.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/tracstoke.h	(revision 1944)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      common /tracstoke/istdyn,istphy,unittrac
-      integer istdyn,istphy,unittrac
Index: DZ5/trunk/libf/dyn3dpar/vitvert.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/vitvert.F	(revision 1944)
+++ 	(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: DZ5/trunk/libf/dyn3dpar/write_grads_dyn.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dpar/write_grads_dyn.h	(revision 1944)
+++ 	(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
-
