C HATSTR    SOURCE    CHAT      05/01/13    00:23:20     5004           
      SUBROUTINE HATSTR (ICOLAC)                                                
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C-----------------------------------------------------------------------        
C                                                                               
C   BUT  :VA A LA PECHE DES CHAPEAUX DES OBJETS SOSTU                           
C         DEJA CONTENUS DANS LES PILES                                          
C LOGIQUE:                                                                      
C       ON SE POINTE SUR LA PILE 9 DES STRUCT                                   
C       ON CREE LA TABLE DES OBJETS DU TYPE DE CETTE PILE                       
C       ON TESTE SI LE POINTEUR DE L OBJET EST DANS LA PILE                     
C       SI OUI, ON PASSE A  L OBJET SUIVANT.                                    
C       SI NON                                                                  
C       SI L ENSEMBLE DES POINTEURS SOSTU EST CONTENU DANS LA PILE 12           
C       ALORS ON RAJOUTE L OBJET DANS LA PILE 9, CE QUI OBLIGE A UN             
C       RAPPEL DE FILLPI                                                        
C                                                                               
C   PROGRAMME PAR :  FARVACQUE-REPRIS PAR LENA                                  
C   APPELE PAR    :  SAUV                                                       
C   APPELLE       :     SORT7   SORT8  ERREUR  REPERT                           
C                                                                               
C=======================================================================        
C  TABLEAU KCOLA :                                                              
C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6 MCLSTR                
C    7  MELSTR  8 MSOLUT  9 MSTRUC 10 MTABLE 11 MAFFEC 12 MSOSTU                
C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL                
C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL                                    
C=======================================================================        
C                                                                               
-INC SMSTRUC                                                                    
-INC CCOPTIO                                                                    
-INC TMCOLAC
      SEGMENT ILISBB
        INTEGER ILISOB(MLON)
      ENDSEGMENT
      DIMENSION IBID(1)
C                                                                               
      CHARACTER*(8) ITYPE                                                       
C                                                                               
      SEGACT ICOLAC
      ILISSE=ILISSG
      SEGACT ILISSE*MOD                                                             
C                                                                               
C                                                                               
C     **************************** MSTRUC ET MSOSTU*********************        
C-----ON SE POINTE SUR LA PILE DES SOSTU                                        
      ITLAC1=KCOLA(12)                                                          
      IMAX1=ITLAC1.ITLAC(/1)                                                    
      IF(IMAX1.EQ.0) GO TO 598                                                  
C                                                                               
C     LA PILE DES SOSTU  N EST PAS VIDE-------------------------------          
      ITYPE='STRUCTUR'                                                          
      IFILE=0                                                                   
      CALL TYPFIL (ITYPE,IFILE)                                                 
      IF (IFILE.LE.0) GO TO 598                                                 
      ITLACC=KCOLA(IFILE) 
      CALL LISTOB(ITYPE,MLON,IBID,0) 
      SEGINI ILISBB
      CALL LISTOB(ITYPE,N,ILISOB,1)                                                     
C      CALL REPERT (ITYPE,N)                                                     
      IF (N.EQ.0) GO TO 599                                                     
C                                                                               
      DO 1500 I   =1,N 
      MSTRU=ILISOB(I)                                                         
C      CALL LIROBJ(ITYPE,MSTRU,1,IRETOU)                                         
      IF(IERR.EQ.0) RETURN                                                      
      CALL SNOM2(MSTRUC,ITLACC,IRET)                                            
      IF(IRET.NE.0) GOTO 1500                                                   
      SEGACT MSTRUC                                                             
      NSOU=LISTRU(/1)                                                           
      CALL SORT8(LISTRU,NSOU,ITLAC1.ITLAC,IMAX1,IRET)
      SEGDES MSTRUC                                                             
      IF(IRET.EQ.1) GOTO 1500                                                   
      CALL AJOUN (ITLACC,MSTRUC,ILISSE,1)                                                
 1500 CONTINUE                                                                  
  599 CONTINUE 
      SEGSUP ILISBB                                                                 
  600 CONTINUE                                                                  
  598 CONTINUE                                                                  
  601 CONTINUE
*      SEGDES ICOLAC,ILISSE                                                             
      RETURN                                                                    
      END