Esope source files

   1 : C FUSEBO    SOURCE    CHAT      07/10/29    21:19:55     5940           
   2 :          
   3 : C    CE SOUS-PROGRAMME L'OPERATION "ET" SUR UN maillage pas beau
   4 : C   ( qui ne respecte pas la partition par type)pour le rendre beau. 
   5 : C   On ne s'occupe pas des references           
   6 : C    IPT1:  en entree  IPT3:  en sortie                            
   7 : C                                                                               
   8 :       SUBROUTINE FUSEBO(IPT1,IPT3)                                           
   9 :       IMPLICIT INTEGER(I-N)
  10 : -INC CCOPTIO                                                                    
  11 : -INC CCGEOME                                                                    
  12 : -INC SMELEME                                                                    
  13 :       SEGMENT ISO1(NBSOU1)                                                      
  14 :       SEGMENT ISO2(NBSOU1)
  15 :       segment iso3(nbsou1)                                                     
  16 :       SEGACT IPT1                                                          
  17 :       NBSOU1= IPT1.LISOUS(/1)    
  18 : *      write(6,*) ' entree dans fusebo  nbsou1 ' , nbsou1
  19 :       segact ipt1                                                                                                                                                                                                                                                                                                                                   
  20 :       SEGINI ISO1,ISO2,iso3                                                         
  21 :       DO 350 I=1,NBSOU1                                                         
  22 :  350  ISO1(I)=IPT1.LISOUS(I)                                                                                                    
  23 :       SEGDES IPT1
  24 :       ity=0 
  25 :       nbref=0
  26 :       nbsous=0                                                         
  27 :       DO 310 I1=1,NBSOU1                                                       
  28 :       IPT1=ISO1(I1)    
  29 :       if(IPT1.EQ.0) go to 310                                               
  30 :       ity = 1 + ity   
  31 :       ias = 1
  32 :       iso3(ias)=ipt1
  33 :       segact ipt1
  34 :       nbnn = ipt1.num(/1)
  35 :       nbelem = ipt1.num(/2)
  36 :       do 330 i2 = i1+1, nbsou1
  37 :       IPT2=ISO1(I2)   
  38 :       IF (IPT2.EQ.0) GOTO 330
  39 :       IPT2=ISO1(I2) 
  40 :       IF (IPT2.EQ.0) GOTO 330
  41 :       SEGACT IPT2   
  42 :       IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 340  
  43 :       IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 340
  44 :       ias = ias+1
  45 :       iso3(ias)= ipt2
  46 :       iso1(i2)=0
  47 :       nbelem = nbelem + ipt2.num(/2)
  48 :   340 continue
  49 :       if(ipt1.ne.ipt2) segdes ipt2
  50 :   330 continue
  51 :       if(ias.eq.1) then
  52 :         iso2(ity) = ipt1  
  53 :         segdes ipt1
  54 :       else 
  55 :         segini meleme
  56 :         idec=0
  57 :         itypel = ipt1.itypel                                                                                                    
  58 :         DO 311 I2=1,ias                                                               
  59 :           IPT1=ISO3(I2)                                                             
  60 :           segact ipt1
  61 :           do 351 nbe=1,ipt1.num(/2)
  62 :           do 352 nbn=1,nbnn
  63 :             num(nbn,idec+nbe)=ipt1.num(nbn,nbe)
  64 :   352     continue
  65 :   351     continue  
  66 :          do 353 nbe=1,ipt1.num(/2)
  67 :   353    icolor(idec+nbe)=ipt1.icolor(nbe)
  68 :           idec = idec + ipt1.num(/2)         
  69 :           segdes ipt1
  70 :   311   continue     
  71 :         iso2(ity)=meleme                                                                 
  72 :         SEGDES meleme 
  73 :       endif                                                              
  74 :  310  CONTINUE                                                                  
  75 :       if( ity.eq.1) then
  76 :         ipt3 = iso2(1)
  77 :       else                                                             
  78 :         NBREF=0                                                                                                                              
  79 :         NBNN=0                                                                    
  80 :         NBELEM=0
  81 :         nbsous = ity                                                                  
  82 :         SEGINI IPT3                                                               
  83 :         DO 111 I=1,NBSOUs                                                         
  84 :         IPT3.LISOUS(I)=ISO2(I)                                                    
  85 :  111    CONTINUE  
  86 :       endif                                                                                                                                       
  87 :       SEGSUP ISO1,ISO2,iso3                                                                                                            
  88 :  1020 SEGDES IPT3     
  89 :       segdes ipt3                                                
  90 :       RETURN                                                                    
  91 :       END                                                                       
  92 :  
  93 :  
  94 :  
  95 :  
  96 :  
  97 :  
  98 :  
  99 :  
 100 :  
 101 :  
 102 :