C EXTRA8    SOURCE    CHAT      11/03/16    21:21:47     6902           
      SUBROUTINE EXTRA8(IPMODE,IPGEOM)                                          
************************************************************************        
*                                                                               
*                             E X T R A 8                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     EXTRAIRE LE MAILLAGE CONTENU DANS UN OBJET "MODELE"                       
*                                                                               
* MODULES UTILISES:                                                             
* -----------------                                                             
*                                                                               
      IMPLICIT INTEGER(I-N)
-INC SMMODEL                                                                    
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)          
* -----------                                                                   
*                                                                               
*     IPMODE  (E)  POINTEUR SUR L'OBJET MODELE                                  
*     IPGEOM  (S)  POINTEUR SUR LE MAILLAGE EXTRAIT DE L'OBJET                  
*                  MODELE                                                       
*                                                                               
* AUTEUR, DATE DE CREATION:                                                     
* -------------------------                                                     
*                                                                               
*     DENIS ROBERT,LE 28 AVRIL 1988.                                            
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
-INC CCOPTIO
      logical ltelq                                                                    
      MMODEL=IPMODE                                                             
      SEGACT,MMODEL                                                             
      NSOUMO=KMODEL(/1)                                                         
*                                                                               
      IMODEL=KMODEL(1)                                                          
      SEGACT,IMODEL                                                             
      IPGEOM=IMAMOD                                                             
      SEGDES,IMODEL                                                       
*                                                                               
      DO 10 ISOUMO=2,NSOUMO                                                     
         IMODEL=KMODEL(ISOUMO)                                                  
         SEGACT,IMODEL                                                          
         IPGEO1=IMAMOD 
         ltelq=.false.                                                         
         CALL FUSE(IPGEOM,IPGEO1,IPGEO2,ltelq)                                        
         IF (IERR.NE.0) THEN                                                    
            IPGEOM=0                                                            
            DO 5 I=2,ISOUMO                                                     
               IMODEL=KMODEL(I)                                                 
               SEGDES,IMODEL                                              
 5             CONTINUE                                                         
*           END DO                                                              
            SEGDES,MMODEL                                                 
            RETURN                                                              
         ENDIF                                                                  
         IPGEOM=IPGEO2                                                          
         SEGDES,IMODEL                                                    
 10      CONTINUE                                                               
*     END DO                                                                    
      SEGDES,MMODEL                                                       
*                                                                               
      END