C FUSEBO    SOURCE    CHAT      07/10/29    21:19:55     5940           
         
C    CE SOUS-PROGRAMME L'OPERATION "ET" SUR UN maillage pas beau
C   ( qui ne respecte pas la partition par type)pour le rendre beau. 
C   On ne s'occupe pas des references           
C    IPT1:  en entree  IPT3:  en sortie                            
C                                                                               
      SUBROUTINE FUSEBO(IPT1,IPT3)                                           
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                                    
-INC CCGEOME                                                                    
-INC SMELEME                                                                    
      SEGMENT ISO1(NBSOU1)                                                      
      SEGMENT ISO2(NBSOU1)
      segment iso3(nbsou1)                                                     
      SEGACT IPT1                                                          
      NBSOU1= IPT1.LISOUS(/1)    
*      write(6,*) ' entree dans fusebo  nbsou1 ' , nbsou1
      segact ipt1                                                                                                                                                                                                                                                                                                                                   
      SEGINI ISO1,ISO2,iso3                                                         
      DO 350 I=1,NBSOU1                                                         
 350  ISO1(I)=IPT1.LISOUS(I)                                                                                                    
      SEGDES IPT1
      ity=0 
      nbref=0
      nbsous=0                                                         
      DO 310 I1=1,NBSOU1                                                       
      IPT1=ISO1(I1)    
      if(IPT1.EQ.0) go to 310                                               
      ity = 1 + ity   
      ias = 1
      iso3(ias)=ipt1
      segact ipt1
      nbnn = ipt1.num(/1)
      nbelem = ipt1.num(/2)
      do 330 i2 = i1+1, nbsou1
      IPT2=ISO1(I2)   
      IF (IPT2.EQ.0) GOTO 330
      IPT2=ISO1(I2) 
      IF (IPT2.EQ.0) GOTO 330
      SEGACT IPT2   
      IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 340  
      IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 340
      ias = ias+1
      iso3(ias)= ipt2
      iso1(i2)=0
      nbelem = nbelem + ipt2.num(/2)
  340 continue
      if(ipt1.ne.ipt2) segdes ipt2
  330 continue
      if(ias.eq.1) then
        iso2(ity) = ipt1  
        segdes ipt1
      else 
        segini meleme
        idec=0
        itypel = ipt1.itypel                                                                                                    
        DO 311 I2=1,ias                                                               
          IPT1=ISO3(I2)                                                             
          segact ipt1
          do 351 nbe=1,ipt1.num(/2)
          do 352 nbn=1,nbnn
            num(nbn,idec+nbe)=ipt1.num(nbn,nbe)
  352     continue
  351     continue  
         do 353 nbe=1,ipt1.num(/2)
  353    icolor(idec+nbe)=ipt1.icolor(nbe)
          idec = idec + ipt1.num(/2)         
          segdes ipt1
  311   continue     
        iso2(ity)=meleme                                                                 
        SEGDES meleme 
      endif                                                              
 310  CONTINUE                                                                  
      if( ity.eq.1) then
        ipt3 = iso2(1)
      else                                                             
        NBREF=0                                                                                                                              
        NBNN=0                                                                    
        NBELEM=0
        nbsous = ity                                                                  
        SEGINI IPT3                                                               
        DO 111 I=1,NBSOUs                                                         
        IPT3.LISOUS(I)=ISO2(I)                                                    
 111    CONTINUE  
      endif                                                                                                                                       
      SEGSUP ISO1,ISO2,iso3                                                                                                            
 1020 SEGDES IPT3     
      segdes ipt3                                                
      RETURN                                                                    
      END