*=*=*=*= grn.html =*=*=*=*
subroutine grn

subroutine grn


      subroutine grn(pext,ucov,vcov,h)
      implicit none

c   sous-programme servant a fitlrer les champs de flux de masse aux
c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
c   et a mesure qu'on se rapproche du pole.
c
c   en entree: pext, pbaru et pbarv
c
c   en sortie: pextm, t wm.
c
c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
c   pas besoin de w en entree.

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comgeom2.h"
#include "comvert.h"

      integer ngroup
      parameter (ngroup=3)


      real pext(iip1,jjp1),h(iip1,jjp1,llm)
      real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)
      real vnat(iip1,jjm,llm)
      real ucont(iip1,jjp1,llm),vcont(iip1,jjm,llm)
      real pbarx(iip1,jjp1),pbary(iip1,jjm),pbarxy(iip1,jjm)

      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)

      real zconvm(iip1,jjp1,llm)

      real uu

      integer i,j,l

      logical firstcall,lfiltreg
      save firstcall,lfiltreg

      data firstcall/.true./

      lfiltreg=.true.
c     if (firstcall) then
c        if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point'
c        firstcall=.false.
         print*,'Utilisation de filtreg ? (T) ou groupeun (F)'
c        read (*,*) lfiltreg
c     endif

      if(lfiltreg) then
         CALL filtreg( pext, jjp1, 1, 2,2, .true., 1)
         CALL filtreg( h, jjp1, llm, 2,1, .true., 1)
      else
         call groupeun(jjp1,1,pext,.false.)
         call groupeun(jjp1,llm,h,.true.)
      endif

      do l=1,llm
         do j=1,jjm
           do i=1,iip1
              vnat(i,j,l)=vcov(i,j,l)/cv(i,j)
           enddo
         enddo
      enddo
      call groupeun(jjm,llm,vnat,.true.)
      do l=1,llm
         do j=1,jjm
           do i=1,iip1
              vcov(i,j,l)=vnat(i,j,l)*cv(i,j)
           enddo
         enddo
      enddo

      CALL covcont ( llm, ucov, vcov, ucont, vcont            )
      CALL pbar    ( pext ,pbarx , pbary, pbarxy              )
      CALL flumass ( pbarx, pbary, vcont, ucont ,pbaru, pbarv )
      call convflu(pbaru,pbarv,llm,zconvm)
      if(lfiltreg) then
         CALL filtreg( zconvm, jjp1, llm, 2,2, .true., 1)
      else
         call groupeun(jjp1,llm,zconvm,.false.)
      endif

c   Champs 3D

      do l=1,llm
         do j=2,jjm
            uu=pbaru(iim,j,l)
            do i=1,iim
               uu=uu+pbarv(i,j,l)-pbarv(i,j-1,l)-zconvm(i,j,l)
c              pbaru(i,j,l)=uu
c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
c    *                      yflu(i,j,l)-yflu(i,j-1,l)
c   ucov=ucont*cu*cu=cu*cu*pbaru/pbarx
               ucov(i,j,l)=uu/(pbarx(i,j)*unscu2(i,j))
            enddo
            ucov(iip1,j,l)=ucov(1,j,l)
         enddo
         do j=1,jjm
            do i=1,iim
               vcov(i,j,l)=pbarv(i,j,l)/(pbary(i,j)*unscv2(i,j))
            enddo
         enddo
      enddo

      return

      end