C PART5     SOURCE    CHAT      06/03/10    21:15:13     5327           
*  partitionne meleme dans itab en fonction de nbzon
*
      SUBROUTINE PART5(MELEME,ITAB,NBZON)
*
      IMPLICIT INTEGER(I-N)
-INC SMELEME
-INC CCOPTIO
      CALL CRTABL(ITAB)
      CALL ECCTAB(ITAB,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,
     #                  0,'MOT',0,0.D0,'ESCLAVE',.TRUE.,0)
*
* cas particulier moins d'élément que de zone 
*
      segact meleme
      inn=0
      if(lisous(/1).eq.0) then
       inn = num(/2)
      else 
        do ia=1,lisous(/1)
         ipt2=lisous(ia)
         segact ipt2
         inn=inn + ipt2.num(/2)
        enddo
      endif
      if(inn.lt.nbzon) then
      segini,ipt1=meleme
            CALL ECCTAB(ITAB,'ENTIER',1,0.D0,' ',.TRUE.,
     #                   0,'MAILLAGE',0,0.D0,' ',.TRUE.,ipt1)
      write(6,*) ' une seule zone crée !!!!!!!!!!!!!!!!!!!!!!'
      segdes ipt1,meleme
      return
      endif
*  boucle sur les zones de maillages à creer
      ja=0
      do 10 iz=1,max(1,nbzon)
*      write(6,*) ' iz ja ' , iz,ja
      ja=0
      segact meleme
      nbnn=0
      nbelem=0
      nbref=0
      nbsous=max(1,lisous(/1))
      segini,ipt4
      jsous=0
      ipt1=meleme
      do 20 isous=1,max(1,lisous(/1))
      if (lisous(/1).ne.0) ipt1=lisous(isous)
      segact ipt1
      segini,ipt5=ipt1
      do 30 j=1,ipt5.num(/2)
      if (mod(j-iz+ja,nbzon).ne.0) then
* on annule l'element
        ipt5.num(1,j)=0
      endif
  30  continue
      ja = ja + ipt5.num(/2)
*  compaction de ipt5
      jf=0
      do 50 j=1,ipt5.num(/2)
      if (ipt5.num(1,j).eq.0) goto 50
      jf=jf+1
      ipt5.icolor(jf)=ipt5.icolor(j)
      do i=1,ipt5.num(/1)
        ipt5.num(i,jf)=ipt5.num(i,j)
      enddo
  50  continue
      nbnn=ipt5.num(/1)
      nbelem=jf
      nbsous=0
      nbref=0
      segadj ipt5
      segdes ipt5
      if (jf.ne.0) then
        jsous=jsous+1
        ipt4.lisous(jsous)=ipt5
      else
        segsup ipt5
      endif
      segdes ipt1
  20  continue
      nbsous=jsous
      nbref=0
      nbnn=0
      nbelem=0
      segadj ipt4
      if (jsous.eq.1) then
         ipt5=ipt4.lisous(1)
         segsup ipt4
         ipt4=ipt5
      endif
      segdes meleme,ipt4
      CALL ECCTAB(ITAB,'ENTIER',iz,0.D0,' ',.TRUE.,
     #                   0,'MAILLAGE',0,0.D0,' ',.TRUE.,ipt4)
  10  continue
      end