C EXTR15    SOURCE    CHAT      11/03/16    21:21:44     6902           
      SUBROUTINE EXTR15(IPMODL,IPCHE1,IPLSTM)                                   
*_____________________________________________________________________          
*                                                                               
*     Extrait les composantes d'un MCHAML                                       
*                                                                               
*  Entrees :                                                                    
*  ---------                                                                    
*                                                                               
*     IPMODL  Pointeur sur un MMODEL                                            
*     IPCHE1  Pointeur sur un MCHAML                                            
*                                                                               
*  Sortie :                                                                     
*  --------                                                                     
*     IPLSTM  Pointeur sur un LISTMOTS                                          
*                                                                               
*  JM CAMPENON le 07/91                                                         
*_____________________________________________________________________          
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*                                                                               
-INC CCOPTIO                                                                    
-INC SMCHAML                                                                    
-INC SMMODEL                                                                    
-INC SMLMOTS                                                                    
*                                                                               
      SEGMENT MTR1                                                              
         INTEGER IPT(0)                                                         
      ENDSEGMENT                                                                
*                                                                               
      IPLSTM=0                                                                  
      JGN=4                                                                     
      JGM=0                                                                     
      MMODEL=IPMODL                                                             
      SEGACT MMODEL                                                             
      NSOUS=KMODEL(/1)                                                          
*                                                                               
      MCHELM=IPCHE1                                                             
      SEGACT MCHELM                                                             
*                                                                               
      SEGINI MTR1                                                               
*                                                                               
      DO 100 ISOUS=1,NSOUS                                                      
         IMODEL=KMODEL(ISOUS)                                                   
         SEGACT IMODEL                                                          
         IPMAIL=IMAMOD                                                          
*                                                                               
         DO 200 IA=1,ICHAML(/1)                                                 
          IF (IMACHE(IA).EQ.IPMAIL.AND.CONCHE(IA).EQ.CONMOD) GOTO 300           
 200     CONTINUE                                                               
*                                                                               
*        Pas de sous zone dans le MCHAML qui corresponde au MMODEL              
*                                                                               
         CALL ERREUR(472)                                                       
         SEGSUP MTR1                                                            
         GOTO 555                                                               
*                                                                               
 300     CONTINUE                                                               
         MCHAML=ICHAML(IA)                                                      
         SEGACT MCHAML                                                          
         NCOMP=NOMCHE(/2)                                                       
         JGM=JGM+NCOMP                                                          
         IPT(**)=IA                                                             
 100  CONTINUE                                                                  
      SEGINI MLMOTS                                                             
      IPLSTM=MLMOTS                                                             
*                                                                               
      IMEM=0                                                                    
      DO 150 ISOUS=1,IPT(/1)                                                    
         MCHAML=ICHAML(IPT(ISOUS))                                              
         NCOMP=NOMCHE(/2)                                                       
*                                                                               
         DO 400 ICOMP=IMEM+1,IMEM+NCOMP                                         
            MOTS(ICOMP)=NOMCHE(ICOMP-IMEM)                                      
 400     CONTINUE                                                               
         IMEM=IMEM+NCOMP                                                        
         SEGDES MCHAML                                                          
 150  CONTINUE                                                                  
*                                                                               
 555  CONTINUE                                                                  
      SEGDES IMODEL
      SEGDES MMODEL                                                             
      SEGDES MCHELM                                                             
      RETURN                                                                    
      END