! $Header$

SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)

  use comconst_mod, only: ngroup

  implicit none

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

  include "dimensions.h"
  include "paramet.h"
  include "comgeom2.h"

  ! integer ngroup
  ! parameter (ngroup=3)

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

  real :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
  real :: wm(iip1, jjp1, llm)

  real :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)

  real :: uu

  integer :: i, j, l

  logical :: firstcall, groupe_ok
  save firstcall, groupe_ok

  data firstcall/.TRUE./
  data groupe_ok/.TRUE./

  if (iim==1) then
    groupe_ok = .FALSE.
  endif

  if (firstcall) then
    if (groupe_ok) then
      if(mod(iim, 2**ngroup)/=0) &
              CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
    endif
    firstcall = .FALSE.
  endif


  !   Champs 1D

  CALL convflu(pbaru, pbarv, llm, zconvm)

  CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
  CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)

  if (groupe_ok) then
    CALL groupeun(jjp1, llm, zconvmm)
    CALL groupeun(jjm, llm, pbarvm)

    !   Champs 3D
    do l = 1, llm
      do j = 2, jjm
        uu = pbaru(iim, j, l)
        do i = 1, iim
          uu = uu + pbarvm(i, j, l) - pbarvm(i, j - 1, l) - zconvmm(i, j, l)
          pbarum(i, j, l) = uu
          ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
          !    *                      yflu(i,j,l)-yflu(i,j-1,l)
        enddo
        pbarum(iip1, j, l) = pbarum(1, j, l)
      enddo
    enddo

  else
    pbarum(:, :, :) = pbaru(:, :, :)
    pbarvm(:, :, :) = pbarv(:, :, :)
  endif

  !    integration de la convergence de masse de haut  en bas ......
  do l = 1, llm
    do j = 1, jjp1
      do i = 1, iip1
        zconvmm(i, j, l) = zconvmm(i, j, l)
      enddo
    enddo
  enddo
  do  l = llm - 1, 1, -1
    do j = 1, jjp1
      do i = 1, iip1
        zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l + 1)
      enddo
    enddo
  enddo

  CALL vitvert(zconvmm, wm)


END SUBROUTINE  groupe