*=*=*=*= groupeun.html =*=*=*=*
subroutine groupeun

subroutine groupeun


      subroutine groupeun(jjmax,llmax,q,intensive)
      implicit none

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

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

      integer ngroup
      parameter (ngroup=3)

      logical intensive

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

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

Champs 3D
      if (intensive) then
      jd=jjp1-jjmax
      do l=1,llmax
      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'
            do i0=1,iim,2**(ngroup-ig+1)
               airen=0.
               airecn=0.
               qn=0.
               aires=0.
               airecs=0.
               qs=0.
               do i=i0,i0+2**(ngroup-ig+1)-1
                  airen=airen+aire(i,j)
                  aires=aires+aire(i,jjp1-j+1)
                  qn=qn+q(i,j,l)*aire(i,j)
                  qs=qs+q(i,jjp1-j+1-jd,l)*aire(i,jjp1-j+1)
               enddo
               airecn=0.
               airecs=0.
               do i=i0,i0+2**(ngroup-ig+1)-1
                  q(i,j,l)=qn/airen
                  q(i,jjp1-j+1-jd,l)=qs/aires
               enddo
            enddo
            q(iip1,j,l)=q(1,j,l)
            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
         enddo
         j1=j2+1
         j2=j2+2**ig
      enddo
      enddo

c  ---------------
      else
c   Cas sans multiplication par les aires.
c  ---------------

      jd=jjp1-jjmax
      do l=1,llmax
      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'
            do i0=1,iim,2**(ngroup-ig+1)
               airen=0.
               airecn=0.
               qn=0.
               aires=0.
               airecs=0.
               qs=0.
               do i=i0,i0+2**(ngroup-ig+1)-1
                  airen=airen+aire(i,j)
                  aires=aires+aire(i,jjp1-j+1)
                  qn=qn+q(i,j,l)
                  qs=qs+q(i,jjp1-j+1-jd,l)
               enddo
               airecn=0.
               airecs=0.
               do i=i0,i0+2**(ngroup-ig+1)-1
                  q(i,j,l)=qn*aire(i,j)/airen
                  q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
               enddo
            enddo
            q(iip1,j,l)=q(1,j,l)
            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
         enddo
         j1=j2+1
         j2=j2+2**ig
      enddo
      enddo

      endif

c     print*,'On groupe jusque j=',j1-1,rlatu(j1-1)*180./pi

      return
      end