C PART6     SOURCE    FANDEUR   11/04/12    21:16:16     6938           

      subroutine part6(nzo,mmodel,itab,ireter)

      implicit integer (i-n)
      implicit real*8(a-h,o-z)

-INC CCOPTIO
-INC SMELEME
-INC SMMODEL
-INC SMTABLE

      segment ipos(nzo)
      segment mta(nzo)

      character*1 cha
      logical bool

      ireter=0
      bool = .TRUE.

      segact mmodel
      n1=kmodel(/1)
      segini ipos,mta

      m=nzo+1
      segini mtable
      itab=mtable
      CALL ECCTAB(mtable,'MOT',0,0.D0,'SOUSTYPE',bool,0
     #                  ,'MOT',0,0.D0,'ESCLAVE' ,bool,0)
      do i=1,nzo      
        segini mmode1
        mta(i)=mmode1
        call ecctab(mtable,'ENTIER',i,0.D0,cha,bool, 0
     $                    ,'MMODEL',0,0.D0,cha,bool,mmode1)
      enddo
      
      nbref=0
      nbsous=0 
      idec=0     
      do isous=1,n1
        imodel=kmodel(isous)
        segact imodel
        meleme=imamod
        segact meleme
        nbelmo=num(/2)
        nf=min(nbelmo,nzo)
        nbnnzo=num(/1)
        nbelzo=nbelmo/nzo+1
        bool = NUMMFR(nefmod).EQ.63
        do i=1,nf 
           idac=mod(i+idec-1,nzo) +1
           nbnn  =nbnnzo
           nbelem=nbelzo
           segini ipt1
           ipt1.itypel=itypel
           jj=0
           do j=i,nbelmo,nf
             jj=jj+1
             do k=1,nbnn
               ipt1.num(k,jj)=num(k,j)
             enddo
           enddo
           if (jj.ne.nbelem) then
             nbelem=jj
             segadj ipt1
           endif
           segdes ipt1
           segini,imode1=imodel
*           write(ioimp,*) conmod(/1), imode1.conmod(/1)
*           write(ioimp,*)' imode1 ' , imode1
*           write(ioimp,*) ' conmod imode1.conmod ',conmod,imode1.conmod
           imode1.imamod=ipt1
           if (imode1.infmod(/1).ge.2) imode1.infmod(2)=0
C-Cas particulier des elements de type XFEM
*           if (bool) write(ioimp,*) ' on appellle partxr'
           IF (bool) CALL PARTXR(imodel,0,imode1)
           segdes imode1
           mmode1=mta(idac)
           ipos(idac)=ipos(idac)+1
*           write(ioimp,*) ' mmode1 ipos(idac) ' , mmode1, ipos(idac)
           mmode1.kmodel(ipos(idac))=imode1 
        enddo
        segdes meleme
        segdes imodel
        idec=mod(idec + nf,nzo) 
      enddo 
      segdes mmodel
* faut-il redimensionner les modeles ?
* (certains modeles élémentaires ne portaient pas sur nzo elements)
      m = 0
      do i=1,nzo
        mmode1=mta(i)        
        n1=ipos(i)
        if (n1.eq.0) then
          if (m.eq.0) m = i
        else
          if (m.ne.0) write(ioimp,*) 'PART6 : cas a signaler ?'
        endif
        if (mmode1.kmodel(/1).ne.n1) then
          segadj mmode1
        endif
*        write(ioimp,*) ' modele numero ' , i
*        call zpmode(mmode1)
        segdes mmode1
      enddo
*  faut-il redimensionner la table aucun des modeles élémentaires 
* n'avait au moins nzo éléments
      if (m.ne.0) then
* on ne garde que les i-1 premieres partitions + le soustype
        mlotab=m
        segadj mtable
      endif
      segdes mtable
      segsup ipos,mta

      return
      end