C CLSTRU    SOURCE    CHAT      09/10/09    21:16:21     6519
      SUBROUTINE CLSTRU
C
C  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN OBJET CL1 DDL FIXES
C  CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IMPLICIT INTEGER(I-N)

-INC PPARAM
-INC CCOPTIO
-INC SMCLSTR
-INC SMSTRUC
-INC SMELEME
-INC SMRIGID
      I22=22
      SEGMENT ITRAV(0)
      SEGMENT ITRA1(0)
C
C     LECTURE DE L'OBJET RIGIDITE CL1
C
      CALL LIROBJ('RIGIDITE',IRET,1,IRETOU)
      IF(IERR.EQ.0) GOTO 10
      MOTERR(1:8)='RIGIDITE'
      CALL ERREUR(37)
C *** PAS D'OBJET DE TYPE RIGIDITE
      CALL ERREUR(37)
      RETURN
   10 MRIGID=IRET
C
C     LECTURE DE LA SOUS-STRUCTURE
C
      CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU)
      IF(IERR.EQ.0) GOTO 25
      MOTERR(1:8)='STRUCTUR'
C *** PAS D'OBJET DE TYPE STRUCTURE
      CALL ERREUR(37)
      RETURN
   25 MSTRUC=KOBJET
      SEGACT MRIGID
      NRIGEL=IRIGEL(/2)
      SEGINI ITRAV
      DO 30 NR=1,NRIGEL
      MELEME=IRIGEL(1,NR)
      SEGACT MELEME
      IF(ITYPEL.EQ.I22) GOTO 26
      SEGSUP ITRAV
      SEGDES MELEME
      SEGDES MRIGID
      CALL ERREUR(99)
C  *** L'OBJET RIGIDITE N'EST PAS DE TYPE CL1
      RETURN
   26 SEGDES MELEME
      ITRAV(**)=MELEME
   30 CONTINUE
      SEGDES MRIGID
      SEGACT MSTRUC
      NSTRU=LISTRU(/1)
      IF(NSTRU.EQ.1) GOTO 35
C
C   LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE
C
      CALL LIRENT(NSTRU,1,IRETOU)
      IF(IERR.EQ.0) GOTO 35
      SEGDES MSTRUC
      SEGSUP ITRAV
C *** L'OBJET CL1 DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE
      INTERR(1)=MSTRUC
      CALL ERREUR(90)
      RETURN
   35 MSOSTU=LISTRU(NSTRU)
      SEGACT MSOSTU
      MRIGID=ISRAID
      SEGACT MRIGID
      SEGINI ITRA1
      NRIGEL=IRIGEL(/2)
      DO 40 IAA=1,NRIGEL
      ITRA1(**)=IRIGEL(1,IAA)
   40 CONTINUE
      SEGDES MRIGID
      SEGDES MSOSTU
      SEGDES MSTRUC
      NL=ITRA1(/1)
      NBPT=ITRAV(/1)
      DO 65 I=1,NBPT
      IKI=ITRAV(I)
      DO 60 J=1,NL
      IF(ITRA1(J).EQ.IKI) GOTO 65
   60 CONTINUE
C  *** UN BLOCAGE N'APPARTIENT PAS A LA SOUS-STRUCTURE
      INTERR(1)=IKI
      INTERR(2)=MSTRUC
      CALL ERREUR(91)
      RETURN
   65 CONTINUE
      SEGSUP ITRAV
      SEGSUP ITRA1
      N=1
      SEGINI MCLSTR
      IRIGCL(1)=IRET
      ISOSTR(1)=MSOSTU
C
C     ECRITURE DU MCLSTR
C
      CALL ECROBJ('BLOQSTRU',MCLSTR)
      SEGDES MCLSTR
      RETURN
      END







