C HATSTR    SOURCE    PV        17/12/05    21:16:26     9646           
      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 PPARAM
-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
      MSTRUC=ILISOB(I)
C      CALL LIROBJ(ITYPE,MSTRUC,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
  598 CONTINUE
*      SEGDES ICOLAC,ILISSE
      RETURN
      END