*=*=*=*= tracvl.html =*=*=*=*
SUBROUTINE tracvl

SUBROUTINE tracvl


      SUBROUTINE tracvl(numvanle,iadvtrac,nq,pbaru,pbarv ,
     *                                     pextfil, q      )
c
c     Auteur :  F. Hourdin
c
      IMPLICIT NONE

c    .........   Version  du 29/04/97    .........
c
#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comvert.h"
#include "comgeom.h"

      INTEGER nq,iadvtrac

      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
      REAL q(ip1jmp1,llm,nq),pextfil(ip1jmp1)

      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
      REAL pextm(ip1jmp1),zdp(ip1jmp1)

      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
      REAL pextg(ip1jmp1)

      INTEGER izdpmin,izdpmax,ismin,ismax


      INTEGER iadvtr, numvanle
      INTEGER ij,l,iq

      SAVE iadvtr, pextm,pbaruc,pbarvc
      DATA iadvtr/0/

      IF(iadvtr.EQ.0) THEN
         CALL initial0(ijp1llm,pbaruc)
         CALL initial0(ijmllm,pbarvc)
      ENDIF

c   accumulation des flux pour les autres quantites.
      DO l=1,llm
         DO ij=1,ip1jmp1
            pbaruc(ij,l)=pbaruc(ij,l)+pbaru(ij,l)
         ENDDO
         DO ij=1,ip1jm
            pbarvc(ij,l)=pbarvc(ij,l)+pbarv(ij,l)
         ENDDO
      ENDDO
      IF(iadvtr.EQ.0) THEN
         CALL SCOPY(ip1jmp1,pextfil,1,pextm,1)
      ENDIF
      iadvtr=iadvtr+1


      IF (iadvtr.EQ.iadvtrac) THEN

      CALL groupe(pextm,pbaruc,pbarvc,pextg,pbarug,pbarvg,wg)

c  test sur l'eventuelle creation de valeurs negatives de la masse
         DO l=1,llm
            DO ij=iip2+1,ip1jm
               zdp(ij)=dsig(l)*(pbarug(ij-1,l)-pbarug(ij,l)
     s                 -pbarvg(ij-iip1,l)+pbarvg(ij,l))
     s                 +wg(ij,l+1)-wg(ij,l)
            ENDDO
            CALL SCOPY(jjp1,zdp(iip1),iip1,zdp,iip1)
            DO ij=iip2,ip1jm
               zdp(ij)=zdp(ij)*dtvr/(dsig(l)*pextg(ij))
            ENDDO

            izdpmin=ismin(ip1jm-iip1,zdp(iip2),1)+iip1
            izdpmax=ismax(ip1jm-iip1,zdp(iip2),1)+iip1

            IF(max(abs(zdp(izdpmin)),abs(zdp(izdpmax))).gt.0.5) THEN
            PRINT*,'WARNING DP/P l=',l,'  MIN:',izdpmin,zdp(izdpmin),
     s        '   MAX:',
     s        izdpmax,zdp(izdpmax)
            ENDIF

         ENDDO

         DO iq = numvanle, nq
         CALL vlsplt(q(1,1,iq),2.,pextg,wg,pbarug,pbarvg,dtvr)
         ENDDO

         iadvtr=0

c   on reinitialise a zero les flux de masse cumules.

      ENDIF ! if iadvtr.EQ.iadvtrac

      RETURN
      END