! $Header$

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

  USE comconst_mod, ONLY: ngroup
  USE lmdz_ssum_scopy, ONLY: scopy
  USE lmdz_comgeom2

  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"

  ! 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