subroutine groupeun_p(jjmax,llmax,jjb,jje,q)
      USE parallel
      implicit none

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

      integer jjmax,llmax,jjb,jje
      real q(iip1,jjmax,llmax)

      integer ngroup
      parameter (ngroup=3)

      real airen,airecn,qn
      real aires,airecs,qs

      integer i,j,l,ig,j1,j2,i0,jd

Champs 3D
      jd=jjp1-jjmax
c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
      do l=1,llm
      j1=1+jd
      j2=2
      do ig=1,ngroup
         do j=j1-jd,j2-jd
c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
            if ( j >= jjb .AND. j <= jje) THEN
             
              do i0=1,iim,2**(ngroup-ig+1)
                 
                 airen=0.
                 airecn=0.
                 qn=0.
                 
                 do i=i0,i0+2**(ngroup-ig+1)-1
                    airen=airen+aire(i,j)
                    qn=qn+q(i,j,l)
                 enddo
                 airecn=0.
                 do i=i0,i0+2**(ngroup-ig+1)-1
                   q(i,j,l)=qn*aire(i,j)/airen
                 enddo
              enddo
              q(iip1,j,l)=q(1,j,l)
              
            endif
            
            if ( jjp1-j+1-jd >= jjb .AND. jjp1-j+1-jd <= jje) THEN
             
              do i0=1,iim,2**(ngroup-ig+1)
                 aires=0.
                 airecs=0.
                 qs=0.
                 do i=i0,i0+2**(ngroup-ig+1)-1
                    aires=aires+aire(i,jjp1-j+1)
                    qs=qs+q(i,jjp1-j+1-jd,l)
                 enddo
                 airecs=0.
                 do i=i0,i0+2**(ngroup-ig+1)-1
                   q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
                 enddo
              enddo
              q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
           
            endif
         enddo
             
           j1=j2+1
           j2=j2+2**ig
      enddo
      enddo
c$OMP END DO NOWAIT
      return
      end