source: LMDZ6/trunk/libf/dyn3dpar/groupe_p.F @ 3138

      subroutine groupe_p(pext,pbaru,pbarv,pbarum,pbarvm,wm)
      USE parallel_lmdz
      USE comconst_mod, ONLY: ngroup
      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:  pbarum,pbarvm et 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 "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,save :: zconvm(iip1,jjp1,llm)
      real,save :: zconvmm(iip1,jjp1,llm)

      real uu

      integer i,j,l

      logical firstcall,groupe_ok
      save firstcall,groupe_ok
c$OMP THREADPRIVATE(firstcall,groupe_ok)

      data firstcall/.true./
      data groupe_ok/.true./

      integer ijb,ije,jjb,jje
      
      if (iim==1) then
         groupe_ok=.false.
      endif

      if (firstcall) then
         if (groupe_ok) then
           if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point'
         endif
         firstcall=.false.
      endif

c   Champs 1D

      call convflu_p(pbaru,pbarv,llm,zconvm)

c
c      call scopy(ijp1llm,zconvm,1,zconvmm,1)
c      call scopy(ijmllm,pbarv,1,pbarvm,1)
      
      jjb=jj_begin
      jje=jj_end

c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
      do l=1,llm
        zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
      enddo
c$OMP END DO NOWAIT

      if (groupe_ok) then
         call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
      endif
      
      jjb=jj_begin-1
      jje=jj_end
      if (pole_nord) jjb=jj_begin
      if (pole_sud)  jje=jj_end-1
c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
      do l=1,llm
        pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
      enddo
c$OMP END DO NOWAIT

      if (groupe_ok) then
         call groupeun_p(jjm,llm,jjb,jje,pbarvm)
      endif

c   Champs 3D
   
      jjb=jj_begin
      jje=jj_end
      if (pole_nord) jjb=jj_begin+1
      if (pole_sud)  jje=jj_end-1
      
c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)      
      do l=1,llm
         do j=jjb,jje
            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
c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
c    *                      yflu(i,j,l)-yflu(i,j-1,l)
            enddo
            pbarum(iip1,j,l)=pbarum(1,j,l)
         enddo
      enddo
c$OMP END DO NOWAIT

c    integration de la convergence de masse de haut  en bas ......
   
      jjb=jj_begin
      jje=jj_end

c$OMP BARRIER
c$OMP MASTER      
      do  l = llm-1,1,-1
          do j=jjb,jje
             do i=1,iip1
                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
             enddo
          enddo
      enddo

      if (.not. pole_sud) then
        zconvmm(:,jj_end+1,:)=0
cym     wm(:,jj_end+1,:)=0
      endif
      
c$OMP END MASTER
c$OMP BARRIER      

      CALL vitvert_p(zconvmm(1,1,1),wm(1,1,1))

      return
      end