1 : C ELSTRU SOURCE FANDEUR 10/12/14 21:16:02 6812 2 : SUBROUTINE ELSTRU 3 : C 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C INDIQUE LA SS-STRUC ELEM A LAQUELLE APPARTIENT UN MELEME (SOUS GEOM 6 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : -INC CCOPTIO 11 : -INC SMELSTR 12 : -INC SMSTRUC 13 : -INC SMELEME 14 : -INC SMRIGID 15 : -INC SMCHAML 16 : SEGMENT ITRAV(0) 17 : SEGMENT ITRA1(0) 18 : C 19 : C LECTURE DU POINT OU ... 20 : C 20 : CALL LIROBJ('POINT ',IRET,0,IRETOU) 21 : IF(IRETOU.EQ.1) THEN 22 : NBNN=1 23 : NBELEM=1 24 : NBSOUS=0 25 : NBREF=0 26 : SEGINI MELEME 27 : ITYPEL=1 28 : NUM(1,1)=IRET 29 : C 30 : C ... LECTURE DU MELEME 31 : C 32 : ELSE 32 : CALL LIROBJ('MAILLAGE',IRET,1,IRETOU) 33 : C *** PAS D'OBJET DE TYPE ELEMENT OU POINT 34 : IF(IERR.NE.0) THEN 35 : MOTERR(1:8)='MAILLAGE' 35 : CALL ERREUR(37) 36 : MOTERR(9:16)='POINT' 36 : CALL ERREUR(37) 37 : RETURN 38 : ENDIF 39 : MELEME=IRET 40 : SEGACT MELEME 41 : IF (ITYPEL.NE.1) THEN 42 : SEGDES MELEME 43 : C *** LE MELEME N'EST PAS ELEMENTAIRE 44 : INTERR(1)=MELEME 44 : CALL ERREUR(89) 45 : RETURN 46 : ENDIF 47 : ENDIF 48 : C 49 : C LECTURE DE LA SOUS-STRUCTURE 50 : C 50 : CALL LIROBJ('STRUCTUR',KOBJET,1,IRETOU) 51 : IF(IERR.NE.0) THEN 52 : MOTERR(1:8)='STRUCTUR' 53 : C *** PAS D'OBJET DE TYPE STRUCTURE 53 : CALL ERREUR(37) 54 : RETURN 55 : ENDIF 56 : C 57 : NBPT=NUM(/2) 58 : SEGINI ITRAV 59 : DO 20 L=1,NBPT 60 : ITRAV(**)=NUM(1,L) 61 : 20 CONTINUE 62 : SEGDES MELEME 63 : IMEL=MELEME 64 : C 65 : MSTRUC=KOBJET 66 : SEGACT MSTRUC 67 : NSTRU=LISTRU(/1) 68 : IF(NSTRU.EQ.1) GOTO 30 69 : C 70 : C LECTURE DU NUMERO DE LA SOUS-STRUCTURE ELEMENTAIRE 71 : C 71 : CALL LIRENT(NSTRU,1,IRETOU) 72 : IF(IERR.EQ.0) GOTO 30 73 : SEGDES MSTRUC 74 : SEGSUP ITRAV 75 : C *** LE MELEM DOIT APPARTENIR A UNE SS STRUC ELEMENTAIRE 76 : INTERR(1)=MSTRUC 76 : CALL ERREUR(90) 77 : RETURN 78 : 30 MSOSTU=LISTRU(NSTRU) 79 : C 80 : C LE MELEME DOIT ETRE INCLUS DANS LA SOUS-STRUCTURE 81 : C 82 : SEGINI ITRA1 83 : SEGACT MSOSTU 84 : IF(ISRAID.EQ.0) THEN 85 : MCHELM=ISCHAM(1) 86 : SEGDES MSOSTU 87 : SEGACT MCHELM 88 : NSOUS=IMACHE(/1) 89 : C 90 : C ******** BOUCLE SUR LES ZONES GEO.ELEM. DU CHAMP DE MATERIAU 91 : C 92 : DO 49 IAB=1,NSOUS 93 : MELEME=IMACHE(IAB) 94 : SEGACT MELEME 95 : IF(ITYPEL.EQ.22) GO TO 47 96 : NBELEM=NUM(/2) 97 : NBP=NUM(/1) 98 : DO 41 NBE=1,NBELEM 99 : DO 41 NP=1,NBP 100 : ITRA1(**)=NUM(NP,NBE) 101 : 41 CONTINUE 102 : 47 SEGDES MELEME 103 : 49 CONTINUE 104 : SEGDES,MCHELM 105 : ELSE 106 : MRIGID=ISRAID 107 : SEGACT MRIGID 108 : NRIGEL=IRIGEL(/2) 109 : C 110 : C BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTURE 111 : C 112 : DO 55 IAA=1,NRIGEL 113 : MELEME=IRIGEL(1,IAA) 114 : SEGACT MELEME 115 : IF(ITYPEL.EQ.22) GOTO 50 116 : NBELEM=NUM(/2) 117 : NBP=NUM(/1) 118 : DO 40 NBE=1,NBELEM 119 : DO 40 NP=1,NBP 120 : ITRA1(**)=NUM(NP,NBE) 121 : 40 CONTINUE 122 : 50 SEGDES MELEME 123 : 55 CONTINUE 124 : SEGDES MRIGID 125 : ENDIF 126 : NL=ITRA1(/1) 127 : DO 65 I=1,NBPT 128 : IKI=ITRAV(I) 129 : DO 60 J=1,NL 130 : IF(ITRA1(J).EQ.IKI) GOTO 65 131 : 60 CONTINUE 132 : C *** UN PT DU MELEME N'APPARTIENT PAS A LA SS STRUCTURE 133 : INTERR(1)=IKI 134 : INTERR(2)=MSTRUC 134 : CALL ERREUR(91) 135 : GOTO 100 136 : 65 CONTINUE 137 : SEGSUP ITRAV 138 : SEGSUP ITRA1 139 : N=1 140 : SEGINI MELSTR 141 : IMELEM(1)=IMEL 142 : ISOSTU(1)=MSOSTU 143 : SEGDES MSOSTU 144 : SEGDES MSTRUC 145 : C 146 : C ECRITURE DU MELSTR 147 : C 147 : CALL ECROBJ('ELEMSTRU',MELSTR) 148 : SEGDES MELSTR 149 : RETURN 150 : 100 CONTINUE 151 : SEGSUP ITRAV 152 : SEGSUP ITRA1 153 : RETURN 154 : END 155 : 156 : 157 :
© Cast3M 2003 - All rights reserved.
Disclaimer