C EXCOPP    SOURCE    PV        13/04/16    21:15:16     7765           
      SUBROUTINE EXCOPP(IPCH1,MOT,IPCH2,MOT2,IVID)                              
C=======================================================================        
C                                                                               
C               EXTRACTION D UNE COMPOSANTE D UN CHPOINT                        
C               ROUTINE APPELLEE PAR L OPERATEUR EXCOMP                         
C ENTREE                                                                        
C     IPCH1= POINTEUR SUR UN CHPOINT                                            
C     MOT  = NOM DE LA COMPOSANTE A EXTRAIRE                                    
C SORTIE                                                                        
C     IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA                    
C            COMPOSANTE  MOT LE NOM DE CETTE COMPOSANTE EST                     
C            REPABTISE  LE CONTENU DE MOT2                                      
C     CODE DECEMBRE 84 MODIFIE NOVEMBRE 1986                                    
C=======================================================================        
      IMPLICIT INTEGER(I-N)
-INC SMCHPOI                                                                    
-INC SMELEME                                                                    
-INC CCOPTIO                                                                                                              
      CHARACTER*4 MOT,MOT1,MOT2                                                 
C                                                                               
      MCHPO1=IPCH1                                                              
      SEGACT MCHPO1                                                             
C                                                                               
C     INITIALISATION DES SEGMENTS DE TRAVAIL                                    
C                                                                                                                                    
C
      MPOVAL=0
      IPT1=0
      NBSOUS=0
      NBREF=0                                                                               
      NSOUP1=MCHPO1.IPCHP(/1)                                                   
C                                                                               
C     BOUCLE SUR LES SOUS PAQUETS DE MCHPO1                                     
C                                                                               
      DO 100 IA=1,NSOUP1                                                        
      MSOUP1=MCHPO1.IPCHP(IA)                                                   
      SEGACT MSOUP1                                                             
      NC1=MSOUP1.NOCOMP(/2)                                                     
      DO 110 IB=1,NC1                                                           
      MOT1=MSOUP1.NOCOMP(IB)                                                    
      IHA=MSOUP1.NOHARM(IB)                                                     
      IF(MOT1.NE.MOT.OR.IHA.NE.NIFOUR)  GOTO 110                                
      IBVAL=IB                                                                  
      GOTO 120                                                                  
  110 CONTINUE                                                                  
C                                                                               
C     ON A PAS TROUVE UNE COMPOSANTE MOT DANS CE SOUS PAQUET                    
C                                                                               
      GOTO 130                                                                  
C                                                                               
C     ON A TROUVE DANS LE SOUS PAQUET UNE COMPOSANTE MOT                        
C                                                                               
 120  CONTINUE                                                                  
      MELEME=MSOUP1.IGEOC                                                       
      MPOVA1=MSOUP1.IPOVAL                                                      
      SEGACT MELEME,MPOVA1                                                      
      NBNN  =NUM(/1)                                                            
      NBELEM=NUM(/2)
      IF(MPOVAL.EQ.0) THEN
         NDEJ=0
         NC=1
         N=NBELEM
         SEGINI MPOVAL
         SEGINI IPT1
      ELSE
         NC=1
         N=NBELEM+NDEJ
         NBELEM=N
         SEGADJ MPOVAL
         SEGADJ IPT1
      ENDIF                                                                                                                         
      DO 140 IC=1,NUM(/2)                                                        
      IPT1.NUM(1,IC+NDEJ)=NUM(1,IC)                                                              
      MPOVAL.VPOCHA(IC+NDEJ,1)=MPOVA1.VPOCHA(IC,IBVAL)                                                                                                     
 140  CONTINUE 
      NDEJ=NDEJ+NUM(/2)                                                                
      SEGDES MELEME,MPOVA1                                                      
 130  CONTINUE                                                                  
      SEGDES MSOUP1                                                             
 100  CONTINUE                                                                  
C                                                                               
                                                         
      IF(MPOVAL.NE.0)  GOTO 200                                                     
C                                                                               
C     ERREUR PAS DE COMPOSANTE DU TYPE RECHERCHE DANS MCHPOI                    
C                                                                               
      IF(IVID.EQ.1) THEN                                                        
          NSOUPO=0   
          NAT=MCHPO1.JATTRI(/1)                                                           
          SEGINI MCHPOI 
          mochde='chpoint vide' 
          mtypoi='SCALAIRE'                                                       
          IFOPOI=MCHPO1.IFOPOI
          DO 160 II=1,NAT
             JATTRI(II)=MCHPO1.JATTRI(II)
 160      CONTINUE                                                  
          IPCH2=MCHPOI                                                          
          SEGDES MCHPOI                                                         
          GO TO 666                                                             
      ELSE                                                                      
          MOTERR(1:4)=MOT                                                       
          CALL ERREUR(181)                                                      
          GOTO 666                                                              
      ENDIF                                                                     
  200 CONTINUE                                                                  
C                                                                               
C     ON REMPLIT LE NOUVEAU CHPOINT                                             
C                                                                               
      NSOUPO=1 
      NAT=MCHPO1.JATTRI(/1)                                                                 
      SEGINI MCHPOI                                                             
      IPCH2=MCHPOI                                                              
      MTYPOI='SCALAIRE'                                                         
      MOCHDE=MCHPO1.MOCHDE
      DO 170 II=1,NAT
          JATTRI(II)=MCHPO1.JATTRI(II)
 170  CONTINUE  
      IFOPOI=MCHPO1.IFOPOI                                                      
      NC=1                                                                      
      SEGINI MSOUPO                                                             
      IPCHP(1)=MSOUPO                                                           
      NOCOMP(1)=MOT2                                                            
      NOHARM(1)=NIFOUR                                                                                                       
      IPOVAL=MPOVAL                                                             
      SEGDES MCHPOI,MSOUPO                                                                                                                  
      SEGDES MPOVAL                                                      
      segact ipt1*mod
      IPT1.ITYPEL=1
      call crech1(ipt1,1)
      IGEOC=IPT1                                                            
      SEGDES IPT1                                                                                                                                  
C                                                                               
 666  CONTINUE                                                                  
C                                                                               
C     SUPPRESSION DES SEGMENTS DE TRAVAIL                                       
C                                                                                                                                     
C                                                                               
      SEGDES MCHPO1                                                             
      RETURN                                                                    
      END