C EXTR35    SOURCE    CHAT      11/03/16    21:21:45     6902           
      SUBROUTINE EXTR35(IPMODL,IPCHE1,IPLSTM)                                   
*_____________________________________________________________________          
*                                                                               
*     Extrait les constituants 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                                                               
         IPT(**)=IA                                                             
         SEGDES IMODEL                                                          
 100  CONTINUE                                                                  
      SEGINI MLMOTS                                                             
      IPLSTM=MLMOTS                                                             
*                                                                               
            DO 40 K=1,IPT(/1)                                               
               if (conche(ipt(k))(1:4).eq.'    ') call erreur (-328)
              if (jgm.gt.0) then
               DO 50 J=1,JGM                                                    
               IF (MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40                           
 50            CONTINUE                                                         
               JGM=JGM+1                                                        
               SEGADJ MLMOTS                                                    
               MOTS(JGM)=CONCHE(ipt(k))(1:4) 
              else
               jgm = 1
               segadj mlmots
               mots(jgm) = conche(ipt(k))(1:4)
              endif                                        
 40         CONTINUE                                                            
                                                        
      SEGDES MMODEL                                                             
      SEGDES MCHELM                                                             
      RETURN                                                                    
*                                                                               
 555  CONTINUE                                                                  
      SEGDES IMODEL
      SEGDES MMODEL                                                             
      SEGDES MCHELM                                                             
      RETURN                                                                    
      END