1 : C CLSTRU SOURCE CHAT 09/10/09 21:16:21 6519 2 : SUBROUTINE CLSTRU 3 : C 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN OBJET CL1 DDL FIXES 6 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : -INC CCOPTIO 10 : -INC SMCLSTR 11 : -INC SMSTRUC 12 : -INC SMELEME 13 : -INC SMRIGID 14 : I22=22 15 : SEGMENT ITRAV(0) 16 : SEGMENT ITRA1(0) 17 : C 18 : C LECTURE DE L'OBJET RIGIDITE CL1 19 : C 19 : CALL LIROBJ('RIGIDITE',IRET,1,IRETOU) 20 : IF(IERR.EQ.0) GOTO 10 21 : MOTERR(1:8)='RIGIDITE' 21 : CALL ERREUR(37) 22 : C *** PAS D'OBJET DE TYPE RIGIDITE 22 : CALL ERREUR(37) 23 : RETURN 24 : 10 MRIGID=IRET 25 : C 26 : C LECTURE DE LA SOUS-STRUCTURE 27 : C 27 : CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU) 28 : IF(IERR.EQ.0) GOTO 25 29 : MOTERR(1:8)='STRUCTUR' 30 : C *** PAS D'OBJET DE TYPE STRUCTURE 30 : CALL ERREUR(37) 31 : RETURN 32 : 25 MSTRUC=KOBJET 33 : SEGACT MRIGID 34 : NRIGEL=IRIGEL(/2) 35 : SEGINI ITRAV 36 : DO 30 NR=1,NRIGEL 37 : MELEME=IRIGEL(1,NR) 38 : SEGACT MELEME 39 : IF(ITYPEL.EQ.I22) GOTO 26 40 : SEGSUP ITRAV 41 : SEGDES MELEME 42 : SEGDES MRIGID 42 : CALL ERREUR(99) 43 : C *** L'OBJET RIGIDITE N'EST PAS DE TYPE CL1 44 : RETURN 45 : 26 SEGDES MELEME 46 : ITRAV(**)=MELEME 47 : 30 CONTINUE 48 : SEGDES MRIGID 49 : SEGACT MSTRUC 50 : NSTRU=LISTRU(/1) 51 : IF(NSTRU.EQ.1) GOTO 35 52 : C 53 : C LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE 54 : C 54 : CALL LIRENT(NSTRU,1,IRETOU) 55 : IF(IERR.EQ.0) GOTO 35 56 : SEGDES MSTRUC 57 : SEGSUP ITRAV 58 : C *** L'OBJET CL1 DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE 59 : INTERR(1)=MSTRUC 59 : CALL ERREUR(90) 60 : RETURN 61 : 35 MSOSTU=LISTRU(NSTRU) 62 : SEGACT MSOSTU 63 : MRIGID=ISRAID 64 : SEGACT MRIGID 65 : SEGINI ITRA1 66 : NRIGEL=IRIGEL(/2) 67 : DO 40 IAA=1,NRIGEL 68 : ITRA1(**)=IRIGEL(1,IAA) 69 : 40 CONTINUE 70 : SEGDES MRIGID 71 : SEGDES MSOSTU 72 : SEGDES MSTRUC 73 : NL=ITRA1(/1) 74 : NBPT=ITRAV(/1) 75 : DO 65 I=1,NBPT 76 : IKI=ITRAV(I) 77 : DO 60 J=1,NL 78 : IF(ITRA1(J).EQ.IKI) GOTO 65 79 : 60 CONTINUE 80 : C *** UN BLOCAGE N'APPARTIENT PAS A LA SOUS-STRUCTURE 81 : INTERR(1)=IKI 82 : INTERR(2)=MSTRUC 82 : CALL ERREUR(91) 83 : RETURN 84 : 65 CONTINUE 85 : SEGSUP ITRAV 86 : SEGSUP ITRA1 87 : N=1 88 : SEGINI MCLSTR 89 : IRIGCL(1)=IRET 90 : ISOSTR(1)=MSOSTU 91 : C 92 : C ECRITURE DU MCLSTR 93 : C 93 : CALL ECROBJ('BLOQSTRU',MCLSTR) 94 : SEGDES MCLSTR 95 : RETURN 96 : END 97 : 98 : 99 : 100 : 101 : 102 : 103 :
© Cast3M 2003 - All rights reserved.
Disclaimer