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