1 : C DYNE13 SOURCE CHAT 11/03/16 21:19:23 6902
2 : SUBROUTINE DYNE13(ITBAS,ITKM,KPREF,KCPR,LMODYN)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * V{rification des objets TBAS, TKM, et notamment de *
11 : * leurs supports. Liste des points de r{f{rence. *
12 : * *
13 : * Param}tres: *
14 : * *
15 : * e ITBAS Table repr{sentant une base modale *
16 : * e ITKM Table contenant les matrices de raideur et de masse *
17 : * s KPREF Segment des points de r{f{rence *
18 : * s KCPR Segment des points *
19 : * *
20 : * Auteur, date de cr{ation: *
21 : * *
22 : * Denis ROBERT-MOUGIN, le 30 mai 1989. *
23 : * *
24 : *--------------------------------------------------------------------*
25 : -INC CCOPTIO
26 : -INC SMRIGID
27 : -INC SMCHPOI
28 : -INC SMELEME
29 : -INC SMCOORD
30 : -INC SMMODEL
31 : *
32 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
33 : SEGMENT,MPREF
34 : INTEGER IPOREF(NPREF)
35 : ENDSEGMENT
36 : *
37 : LOGICAL L0,L1,LMODYN
38 : CHARACTER*4 MO2
39 : CHARACTER*8 TYPRET,CHARRE
40 : CHARACTER*40 MONMOT
41 : *
42 : IK = 0
43 : IRIG = 0
44 : IMAS = 0
45 : IMESS = 0
46 : SEGINI,ICPR
47 : KCPR = ICPR
48 : LCPR = XCOOR(/1)/(IDIM+1)
49 : *
50 : * 1/ Cas oº la base modale est d{finie seule
51 : *
52 : IF (ITBAS.NE.0 .AND.ITKM.EQ.0.and.(.not.lmodyn)) THEN
52 : CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0,
53 : & 'MOT',I1,X1,MONMOT,L1,IP1)
54 : IF (IERR.NE.0) RETURN
55 : *
56 : * Cas oº la base est unique
57 : *
58 : IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN
59 : *
60 : * On r{cup}re la base de modes
61 : *
61 : CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0,
62 : & 'TABLE',I1,X1,' ',L1,IBAS)
63 : IF (IERR.NE.0) RETURN
63 : CALL DYNE25(IBAS,KCPR,IK)
64 : IF (IERR.NE.0) RETURN
65 : *
66 : * Cas oº on a un ensemble de bases
67 : *
68 : ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
69 : *
70 : * On boucle sur le nombre de bases
71 : *
72 : IB = 0
73 : 10 CONTINUE
74 : IB = IB + 1
75 : TYPRET = ' '
75 : CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
76 : & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
77 : IF (IERR.NE.0) RETURN
78 : IF (ITTBAS.NE.0) THEN
79 : IF (TYPRET.EQ.'TABLE ') THEN
79 : CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0,
80 : & 'TABLE',I1,X1,' ',L1,IBAS)
81 : IF (IERR.NE.0) RETURN
81 : CALL DYNE25(IBAS,KCPR,IK)
82 : IF (IERR.NE.0) RETURN
83 : GOTO 10
84 : ELSE
84 : CALL ERREUR(491)
85 : RETURN
86 : ENDIF
87 : ENDIF
88 : *
89 : * Cas oº le SOUSTYPE est incorrect
90 : *
91 : ELSE
91 : CALL ERREUR(482)
92 : RETURN
93 : ENDIF
94 : *
95 : * 2/ Cas oº les matrices raideur et de masse sont d{finies seules
96 : *
97 : ELSE IF (ITBAS.EQ.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
98 : TYPRET = ' '
98 : CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
99 : & TYPRET,I1,X1,CHARRE,L1,IRIG)
100 : IF (IERR.NE.0) RETURN
101 : IF (IRIG.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
102 : MRIGID = IRIG
103 : SEGACT,MRIGID
104 : NRIG = IRIGEL(/2)
105 : DO 20 I=1,NRIG
106 : MELEME = IRIGEL(1,I)
107 : SEGACT,MELEME
108 : NBEL = NUM(/2)
109 : NBNN = NUM(/1)
110 : DO 25 J=1,NBEL
111 : DO 26 K=1,NBNN
112 : KNOE = NUM(K,J)
113 : IF (ICPR(KNOE).EQ.0) THEN
114 : IK = IK + 1
115 : ICPR(KNOE) = IK
116 : IF (IIMPI.EQ.333) THEN
117 : WRITE(IOIMP,*)'DYNE13 : raideur ICPR(',KNOE,')=',ICPR(KNOE)
118 : ENDIF
119 : ENDIF
120 : 26 CONTINUE
121 : * end do
122 : 25 CONTINUE
123 : * end do
124 : SEGDES,MELEME
125 : 20 CONTINUE
126 : * end do
127 : SEGDES,MRIGID
128 : *
129 : * Cas oº le SOUSTYPE est incorrect
130 : *
131 : ELSE
131 : CALL ERREUR(483)
132 : RETURN
133 : ENDIF
134 : *
135 : TYPRET = ' '
135 : CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0,
136 : & TYPRET,I1,X1,CHARRE,L1,IMAS)
137 : IF (IERR.NE.0) RETURN
138 : IF (IMAS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN
139 : MRIGID = IMAS
140 : SEGACT,MRIGID
141 : NMAS = IRIGEL(/2)
142 : DO 30 I=1,NMAS
143 : MELEME = IRIGEL(1,I)
144 : SEGACT,MELEME
145 : NBEL = NUM(/2)
146 : NBNN = NUM(/1)
147 : DO 35 J=1,NBEL
148 : DO 36 K=1,NBNN
149 : KNOE = NUM(K,J)
150 : IF (ICPR(KNOE).EQ.0) THEN
151 : IK = IK + 1
152 : ICPR(KNOE) = IK
153 : IF (IIMPI.EQ.333) THEN
154 : WRITE(IOIMP,*)'DYNE13 : masse ICPR(',KNOE,')=',ICPR(KNOE)
155 : ENDIF
156 : ENDIF
157 : 36 CONTINUE
158 : * end do
159 : 35 CONTINUE
160 : * end do
161 : SEGDES,MELEME
162 : 30 CONTINUE
163 : * end do
164 : SEGDES,MRIGID
165 : *
166 : * Cas oº le SOUSTYPE est incorrect
167 : *
168 : ELSE
168 : CALL ERREUR(484)
169 : RETURN
170 : ENDIF
171 : *
172 : * 3/ Cas oº la base modale est d{finie
173 : * et les matrices masse et rigidit{ sont d{finies
174 : *
175 : ELSE IF (ITBAS.NE.0 .AND. ITKM.NE.0.and.(.not.lmodyn)) THEN
175 : CALL ERREUR(478)
176 : RETURN
177 : *
178 : * table pasapas
179 : ELSE IF (LMODYN) THEN
180 : mmodel = itbas
181 : segact mmodel
182 : do im = 1,kmodel(/1)
183 : imodel = kmodel(im)
184 : segact imodel
185 : if (nefmod.ne.45) goto 45
186 : meleme = imamod
187 : segact meleme
188 : do ip = 1,num(/2)
189 : knoe = num(1,ip)
190 : IF (KNOE.NE.0) THEN
191 : IF (ICPR(KNOE).EQ.0) THEN
192 : IK = IK + 1
193 : ICPR(KNOE) = IK
194 : IF (IIMPI.EQ.333) THEN
195 : WRITE(IOIMP,*)'DYNE25 : basemo. ICPR(',KNOE,')=',ICPR(KNOE)
196 : ENDIF
197 : ENDIF
198 : ENDIF
199 : enddo
200 : segdes meleme
201 : 45 continue
202 : segdes imodel
203 : enddo
204 : segdes mmodel
205 : ENDIF
206 : *
207 : * 5/ Cr{ation du segment d{finissant les points supports:
208 : *
209 : NPREF = IK
210 : SEGINI,MPREF
211 : KPREF = MPREF
212 : DO 100 I=1,LCPR
213 : IF (ICPR(I).NE.0) THEN
214 : IREF = ICPR(I)
215 : IPOREF(IREF) = I
216 : IF (IIMPI.EQ.333) THEN
217 : WRITE(IOIMP,*)'DYNE13 : IPOREF(',IREF,')=',IPOREF(IREF)
218 : ENDIF
219 : ENDIF
220 : 100 CONTINUE
221 : * end do
222 : *
223 : END
224 :
225 :
226 :
227 :
228 :
229 :
230 :
231 :
232 :
233 :
© Cast3M 2003 - All rights reserved.
Disclaimer