C EXCOC1    SOURCE    PV        11/04/08    21:15:52     6936           
      SUBROUTINE EXCOC1(IPCH1,MOT,IPCH2,MOT2,IVID)                              
*-----------------------------------------------------------------------        
*     EXTRACTION D UNE COMPOSANTE D UN NOUVEAU CHAMELEM                         
*             ROUTINE APPELLEE PAR L OPERATEUR EXCOMP                           
* ENTREE                                                                        
*     IPCH1= POINTEUR SUR UN CHAMELEM                                           
*     MOT  = NOM DE LA COMPOSANTE A EXTRAIRE                                    
*     MOT2 = NOM DE LA COMPOSANTE                                               
*     IVID = 1 SI ON A LU LE MOT 'NOID', 0 SINON                                
* SORTIE                                                                        
*     IPCH2= POINTEUR SUR LE CHPOINT CONTENANT UNIQUEMENT LA                    
*            COMPOSANTE  MOT2                                                   
*-----------------------------------------------------------------------        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
      CHARACTER*4 MOT,MOT2                                                      
      CHARACTER*8 LEMOT                                                         
-INC SMCHAML                                                                    
-INC CCOPTIO                                                                    
*                                                                               
      SEGMENT MTRI                                                              
        INTEGER IPOI(n1l)
      ENDSEGMENT                                                                
      SEGMENT MTRA                                                              
        INTEGER LRAN(n1l)
      ENDSEGMENT                                                                
      SEGMENT MTRB                                                              
        CHARACTER*16 TYPT(n1l)
      ENDSEGMENT                                                                
*                                                                               
      MCHEL1=IPCH1                                                              
      SEGACT MCHEL1                                                             
      NZON1=MCHEL1.ICHAML(/1)                                                   
*                                                                               
*     INITIALISATION DES SEGMENTS DE TRAVAIL                                    
*                                                                               
      n1=0
      n1l=500
      SEGINI MTRI,MTRA,MTRB                                                     
*                                                                               
*     BOUCLE SUR LES ZONES                                                      
*                                                                               
      DO 100 IA=1,NZON1                                                         
         MCHAM1=MCHEL1.ICHAML(IA)                                               
         SEGACT MCHAM1                                                          
         NCP=MCHAM1.NOMCHE(/2)                                                  
         DO 110 IB=1,NCP                                                        
         LEMOT=MCHAM1.NOMCHE(IB)                                                
            IF (MOT.EQ.LEMOT(1:4)) THEN                                         
               IBCOM=IB                                                         
               GOTO 120                                                         
            ENDIF                                                               
 110     CONTINUE                                                               
*pv      SEGDES MCHAM1
         GOTO 100                                                               
*                                                                               
 120     CONTINUE                                                               
         MELVA1=MCHAM1.IELVAL(IBCOM)
         SEGACT MELVA1                                            
         SEGINI,MELVAL=MELVA1    
*pv      SEGDES MELVA1
         n1=n1+1
         if (n1.gt.n1l) then
          n1l=n1l+500
          segadj mtri,mtra,mtrb
         endif
         IPOI(n1)=MELVAL
         LRAN(n1)=IA
         TYPT(n1)=MCHAM1.TYPCHE(IBCOM)
*pv      SEGDES MELVAL,MCHAM1
         SEGDES MELVAL
 100  CONTINUE                                                                  
*                                                                               
*        ON REMPLIT LE CHAMELEM                                                 
*                                                                               
      L1=mchel1.titche(/1)                                                                      
***   N1=IPOI(/1)
      N3=MCHEL1.INFCHE(/2)                                                      
      N2=1                                                                      
*                                                                               
      IF (N1.EQ.0) THEN                                                         
      IF (IVID.EQ.1) THEN                                                       
         SEGINI MCHELM                                                          
         IPCH2 = MCHELM                                                         
         TITCHE= mchel1.titche                                                     
         IFOCHE=MCHEL1.IFOCHE                                                   
*pv      SEGDES MCHELM
         SEGDES MCHELM
      ELSE                                                                      
         MOTERR(1:4)=MOT                                                        
         CALL ERREUR(236)                                                       
      ENDIF                                                                     
      GOTO 666                                                                  
      ENDIF                                                                     
*                                                                               
*     CREATION DU CHAPEAU DU CHAMELEM                                           
*                                                                               
      SEGINI MCHELM                                                             
      IPCH2=MCHELM                                                              
      TITCHE=mchel1.titche                                                         
      IFOCHE=MCHEL1.IFOCHE                                                      
*                                                                               
*     BOUCLE SUR LES ZONES                                                      
*                                                                               
      DO 400 IA=1,N1                                                            
         IACON=LRAN(IA)                                                         
           DO 401 IAA=1,N3                                                      
           INFCHE(IA,IAA)=MCHEL1.INFCHE(IACON,IAA)                              
  401      CONTINUE                                                             
         IMACHE(IA)=MCHEL1.IMACHE(IACON)                                        
         CONCHE(IA)=MCHEL1.CONCHE(IACON)                                        
         SEGINI,MCHAML                                                          
         ICHAML(IA)=MCHAML                                                      
         LEMOT(1:4)=MOT2                                                        
         NOMCHE(1)=LEMOT                                                        
         TYPCHE(1)=TYPT(IA)                                                     
         IELVAL(1) = IPOI(IA)                                                   
*pv      SEGDES,MCHAML
         SEGDES,MCHAML
 400  CONTINUE                                                                  
*pv   SEGDES MCHELM
      SEGDES MCHELM
*                                                                               
 666  CONTINUE                                                                  
*                                                                               
*     SUPPRESSION DES SEGMENTS DE TRAVAIL                                       
*                                                                               
      SEGSUP MTRI,MTRA,MTRB                                                     
*pv   SEGDES MCHEL1
      RETURN                                                                    
      END