1 : C RIGTAB SOURCE CHAT 09/10/09 21:24:00 6519
2 : SUBROUTINE RIGTAB(ITBAS,ITBST,IRIG,IRET)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 :
6 : *--------------------------------------------------------------------*
7 : * *
8 : * calcule pour les modes les petites matrices RIGIDITE contenant *
9 : * la masse (IRIG = 1), la raideur (IRIG = 2), ou amortissement *
10 : * (IRIG = 3). Ces matrices sont associ{es @ l'{l{ment qui con- *
11 : * tient le point qui est l'indice de chaque mode. *
12 : * *
13 : * Param}tres: *
14 : * *
15 : * e ITBAS table de mode, de sous-type BASE_DE_MODES *
16 : * e IRIG 1, 2, ou 3 *
17 : * s IRET matrice de masse, de rigidit{, ou d'amortissement *
18 : * *
19 : * Auteur, date de cr{ation: *
20 : * *
21 : * Lionel VIVAN, le 7 juin 1990. *
22 : * *
23 : *--------------------------------------------------------------------*
24 : * *
25 : -INC CCOPTIO
26 : -INC CCREEL
27 : *-
28 : -INC SMELEME
29 : -INC SMRIGID
30 : -INC SMTABLE
31 : -INC SMLMOTS
32 : *
33 : LOGICAL L0,L1,ltelq
34 : CHARACTER*8 TYPRET,CHARRE
35 : * CHARACTER*4 lesinc(6),lesdua(6)
36 : PARAMETER (jgm=12)
37 : CHARACTER*4 lesinc(jgm),lesdua(jgm)
38 : DATA lesinc/'UX','UY','UZ','RX','RY','RZ',
39 : >'IUX','IUY','IUZ','IRX','IRY','IRZ'/
40 : DATA lesdua/'FX','FY','FZ','MX','MY','MZ',
41 : >'IFX','IFY','IFZ','IMX','IMY','IMZ'/
42 : *
43 : IRET = 0
44 : IF (IRIG.NE.1 .AND. IRIG.NE.2 .AND. IRIG.NE.3) RETURN
45 : *
46 : NRIGE = 8
47 : NRIGEL = 1
48 : SEGINI MRIGID
49 : IF (IRIG.EQ.1) THEN
50 : MTYMAT = 'MASSE '
51 : ELSE IF (IRIG.EQ.2) THEN
52 : MTYMAT = 'RIGIDITE'
53 : ELSE
54 : MTYMAT = 'AMORMODA'
55 : ENDIF
56 :
57 : IFORIG = IFOMOD
58 : COERIG(1) = 1.D0
59 : IMGEO1 = 0
60 : IMGEO2 = 0
61 : ICHOLE = 0
62 : ISUPEQ = 0
63 : *
64 : IRIGEL(2,1) = 0
65 : IRIGEL(5,1) = NIFOUR
66 : IRIGEL(6,1) = 0
67 :
68 : mrimod = 0
69 : if (itbas.eq.0) goto 30
70 :
71 : NLIGRP = 1
72 : NLIGRD = 1
73 : SEGINI DESCR
74 : IRIGEL(3,1) = DESCR
75 : NOELEP(1) = 1
76 : NOELED(1) = 1
77 : LISINC(1) = 'ALFA'
78 : LISDUA(1) = 'FALF'
79 : SEGDES DESCR
80 : *
81 : mtable = itbas
82 : segact mtable
83 : mlo = mlotab
84 : IM = 0
85 : 10 CONTINUE
86 : IM = IM + 1
87 : TYPRET = ' '
87 : CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
88 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
89 : IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
89 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
90 : & 'POINT',I1,X1,' ',L1,IPTS)
90 : CALL CRELEM(IPTS)
91 :
92 : IF (IM.EQ.1) THEN
93 : IPT1 = IPTS
94 : ELSE
95 : IPT2 = IPTS
96 : ltelq=.false.
96 : CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
97 : IF (IERR.NE.0) RETURN
98 : IPT1 = IMAIL
99 : ENDIF
100 : GOTO 10
101 : ENDIF
102 : if (im.lt.mlo) goto 10
103 : if (ipt1.eq.0) then
104 : interr(1) = 1
105 : if (mrigid.gt.0) segsup mrigid
105 : call erreur(974)
106 : return
107 : endif
108 :
109 : IRIGEL(1,1) = IPT1
110 : *
111 : segact ipt1
112 : NBMODE = ipt1.num(/2)
113 : segdes ipt1
114 : NELRIG = NBMODE
115 : SEGINI xMATRI
116 : IRIGEL(4,1) = xMATRI
117 : NLIGRP=1
118 : NLIGRD=1
119 : DO 20 IM = 1,NBMODE
120 : * SEGINI XMATRI
121 : * IMATTT(IM) = XMATRI
121 : CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
122 : & 'TABLE',I1,X1,' ',L1,ITMOD)
122 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
123 : & 'FLOTTANT',I1,XMGEN,' ',L1,IP1)
124 : IF (IRIG.EQ.1) THEN
125 : RE(1,1,im) = XMGEN
126 : ELSE IF (IRIG.EQ.2) THEN
126 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
127 : & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
128 : OMEG = 2. * XPI * XFREQ
129 : OMEG = OMEG * OMEG
130 : RE(1,1,im) = XMGEN * OMEG
131 : ELSE
131 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
132 : & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
133 : OMEG = 2. * XPI * XFREQ
134 : RE(1,1,im) = XMGEN * OMEG * 2.
135 : ENDIF
136 : * SEGDES XMATRI
137 : 20 CONTINUE
138 :
139 : SEGDES xMATRI
140 : *
141 : mrimod = mrigid
142 : SEGDES MRIGID
143 : if (itbst.eq.0) goto 80
144 :
145 : 30 continue
146 : jgn = 4
147 : c jgm = 6
148 : segini mlmots
149 : iinc = mlmots
150 : do igm = 1,jgm
151 : mots(igm) = lesinc(igm)
152 : enddo
153 : segini mlmots
154 : idua = mlmots
155 : do igm= 1,jgm
156 : mots(igm) = lesdua(igm)
157 : enddo
158 :
159 : if (itbas.ne.0) then
160 : segini,ri1=mrigid
161 : mrigid = ri1
162 : endif
163 : mrista = mrigid
164 :
165 : NLIGRP = 1
166 : NLIGRD = 1
167 : SEGINI DESCR
168 : IRIGEL(3,1) = DESCR
169 : NOELEP(1) = 1
170 : NOELED(1) = 1
171 : LISINC(1) = 'BETA'
172 : LISDUA(1) = 'FBET'
173 : SEGDES DESCR
174 : *
175 :
176 : mtable = itbst
177 : segact mtable
178 :
179 : IM = 0
180 : IPT1 = 0
181 : 40 CONTINUE
182 : IM = IM + 1
183 : itmod = mtabiv(im)
184 : typret = mtabtv(im)
185 : IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
185 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
186 : & 'POINT',I1,X1,' ',L1,IPTS)
186 : CALL CRELEM(IPTS)
187 : IF (IPT1.EQ.0) THEN
188 : IPT1 = IPTS
189 : ELSE
190 : IPT2 = IPTS
191 : ltelq=.false.
191 : CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
192 : IF (IERR.NE.0) RETURN
193 : IPT1 = IMAIL
194 : ENDIF
195 : GOTO 40
196 : ENDIF
197 : if (im.lt.mlotab) goto 40
198 : IRIGEL(1,1) = IPT1
199 : if (ipt1.le.0) then
200 : interr(1) = 2
201 : if (mrigid.gt.0) segsup mrigid
201 : call erreur(974)
202 : return
203 : endif
204 :
205 : segact ipt1
206 : NBMODE = ipt1.num(/2)
207 : segdes ipt1
208 : NELRIG = NBMODE
209 : SEGINI xMATRI
210 : IRIGEL(4,1) = xMATRI
211 : NLIGRP=1
212 : NLIGRD=1
213 :
214 :
215 : IM = 0
216 : IMA = 0
217 : 50 CONTINUE
218 : IM = IM + 1
219 : itmod = mtabiv(im)
220 : typret = mtabtv(im)
221 : IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
222 : * SEGINI XMATRI
223 : IMA = IMA + 1
224 : * IMATTT(IMA) = XMATRI
225 : ITAB2=itmod
226 : IF (IRIG.EQ.1) THEN
226 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
227 : & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
227 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
228 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
229 : if (ierr.ne.0) return
229 : CALL XTY1(itdepl,itreac,iinc,idua,X1)
230 : re(1,1,ima) = x1
231 : ELSE IF (IRIG.EQ.2) THEN
231 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
232 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
232 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
233 : & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
233 : CALL XTY1(itdepl,itreac,iinc,idua,X1)
234 : if (ierr.ne.0) return
235 : RE(1,1,ima) = x1
236 : ELSE
237 : MTYMAT = 'AMORMODA'
238 : ENDIF
239 : * segdes xmatri
240 : ENDIF
241 :
242 : if (im.lt.mlotab) goto 50
243 : segdes xmatri
244 : *
245 : if (mrimod.gt.0) then
245 : call fusrig(mrimod,mrista,mrigid)
246 : else
247 : goto 79
248 : endif
249 : if (irig.gt.2) goto 79
250 :
251 : mridec = mrigid
252 : mrigid = mrimod
253 : ri1 = mrimod
254 : ri2 = mrista
255 : segact ri1,ri2
256 : ipt1 = ri1.irigel(1,1)
257 : ipt2 = ri2.irigel(1,1)
258 : segdes ri1,ri2
259 :
260 : segact ipt1,ipt2
261 :
262 : NRIGE = 8
263 : NRIGEL = 2
264 : * hypothèse modes vib bloqués - pour la rigidite inutile de les coupler
265 : if (irig.eq.2) nrigel = 1
266 : * il faut suffisamment de modes statiques
267 : if (ipt2.num(/2).eq.1) nrigel = 1
268 : SEGINI MRIGID
269 : * write (6,*) ' ini mrigid ',mrigid,nrigel
270 : mricou = mrigid
271 : IF (IRIG.EQ.1) THEN
272 : MTYMAT = 'MASSE '
273 : ELSE IF (IRIG.EQ.2) THEN
274 : MTYMAT = 'RIGIDITE'
275 : ELSE
276 : MTYMAT = 'AMORMODA'
277 : ENDIF
278 : IFORIG = IFOMOD
279 : COERIG(1) = 1.D0
280 : if (nrigel.gt.1) COERIG(2) = 1.D0
281 : IMGEO1 = 0
282 : IMGEO2 = 0
283 : ICHOLE = 0
284 : ISUPEQ = 0
285 : *
286 : IRIGEL(2,1) = 0
287 : IRIGEL(5,1) = NIFOUR
288 : IRIGEL(6,1) = 0
289 : if (nrigel.gt.1) IRIGEL(2,2) = 0
290 : if (nrigel.gt.1) IRIGEL(5,2) = NIFOUR
291 : if (nrigel.gt.1) IRIGEL(6,2) = 0
292 :
293 : * hypothèse mod vib bloques
294 : if (irig.eq.2) goto 64
295 : NBELEM = ipt1.num(/2) * ipt2.num(/2)
296 : NBNN = 2
297 : NBSOUS = 0
298 : NBREF = 0
299 : SEGINI MELEME
300 : ITYPEL=27
301 : NELRIG=NBELEM
302 : NLIGRP=2
303 : NLIGRD=2
304 : SEGINI xMATRI
305 : SEGINI DESCR
306 : NOELEP(1)=1
307 : NOELEP(2)=2
308 : NOELED(1)=1
309 : NOELED(2)=2
310 : LISINC(1)='ALFA'
311 : LISINC(2)='BETA'
312 : LISDUA(1)='FALF'
313 : LISDUA(2)='FBET'
314 : SEGDES DESCR
315 : irigel(1,1) = meleme
316 : irigel(3,1) = descr
317 : IRIGEL(4,1) = xMATRI
318 :
319 : 64 if (ipt2.num(/2).le.1) goto 61
320 : nbelem = ipt2.num(/2)*(ipt2.num(/2) - 1) / 2
321 : NBNN = 2
322 : NBSOUS = 0
323 : NBREF = 0
324 : SEGINI MELEME
325 : ITYPEL=27
326 : NELRIG=NBELEM
327 : NLIGRP=2
328 : NLIGRD=2
329 : SEGINI xMATRI
330 : SEGINI DESCR
331 : NOELEP(1)=1
332 : NOELEP(2)=2
333 : NOELED(1)=1
334 : NOELED(2)=2
335 : LISINC(1)='BETA'
336 : LISINC(2)='BETA'
337 : LISDUA(1)='FBET'
338 : LISDUA(2)='FBET'
339 : SEGDES DESCR
340 : irigel(1,nrigel) = meleme
341 : irigel(3,nrigel) = descr
342 : IRIGEL(4,nrigel) = xMATRI
343 :
344 : 61 continue
345 : * distingue les kas couplage mode_vib/mod_stat et couplage mode_stat/mode_stat
346 : kas = 1
347 : iima = ipt1.num(/2)
348 : * hypothese mod vib bloques
349 : if (irig.eq.2) then
350 : kas = kas + 1
351 : iima = ipt2.num(/2) - 1
352 : endif
353 : meleme = irigel(1,1)
354 : xmatri = irigel(4,1)
355 : segact meleme*mod,xmatri*mod
356 : 62 continue
357 : kelem = 0
358 : do ii = 1, iima
359 : IF (IRIG.EQ.1) THEN
360 : IF (kas.EQ.1) THEN
360 : CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
361 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
361 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
362 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
363 : ELSE IF (kas.EQ.2) THEN
363 : CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
364 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
364 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
365 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
366 : ENDIF
367 : ELSE IF (IRIG.EQ.2) THEN
368 : IF (kas.EQ.1) THEN
368 : CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
369 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
369 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
370 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
371 : ELSE IF (kas.EQ.2) THEN
371 : CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
372 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
372 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
373 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
374 : ENDIF
375 :
376 : ELSE IF (IRIG.EQ.3) THEN
377 : *
378 : ENDIF
379 : * write(6,*) 'gk' , num(/1),num(/2), ii,kelem,kas
380 : if (kas.eq.1) then
381 : jjin = 1
382 : elseif (kas.eq.2) then
383 : jjin = ii + 1
384 : endif
385 :
386 : do jj = jjin,ipt2.num(/2)
387 : kelem = kelem +1
388 : * write(6,*) 'jh' , kelem ,num(/2),ipt2.num(/2),jj
389 : if (kas.eq.1) then
390 : num(1,kelem) = ipt1.num(1,ii)
391 : elseif (kas.eq.2) then
392 : num(1,kelem) = ipt2.num(1,ii)
393 : endif
394 : num(2,kelem) = ipt2.num(1,jj)
395 : mtable = itbst
396 : segact mtable
397 : ima = 0
398 : im = 0
399 : 65 im = im + 1
400 : itab2 = mtabiv(im)
401 : typret = mtabtv(im)
402 : if (ITAB2.NE.0 .AND. TYPRET.EQ.'TABLE ') ima = ima + 1
403 : if (ima.ne.jj) goto 65
404 : * SEGINI XMATRI
405 : * IMATTT(kelem) = XMATRI
406 :
407 : IF (IRIG.EQ.1) THEN
407 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
408 : & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
409 : c t(mode ou sol_stat)*Masse*Sol_stat
410 : ELSE IF (IRIG.EQ.2) THEN
410 : CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
411 : & 'CHPOINT ',I1,X1,' ',L1,ITREAC)
412 : c t(mode ou sol_stat)* Reac(Sol_stat)
413 : ELSE
414 : c MTYMAT = 'AMORMODA'
415 : ENDIF
415 : CALL XTY1(itdepl,itreac,iinc,idua,X1)
416 : re(2,1,kelem) = x1
417 : re(1,2,kelem) = re(2,1,kelem)
418 :
419 : * segdes xmatri
420 : enddo
421 : enddo
422 :
423 : segdes meleme,xmatri
424 : if (kas.eq.1.and.ipt2.num(/2).gt.1) then
425 : kas = kas + 1
426 : iima = ipt2.num(/2) - 1
427 : meleme = irigel(1,kas)
428 : xmatri = irigel(4,kas)
429 : goto 62
430 : endif
431 : continue
432 : segdes ipt1,ipt2
433 : mrigid=mridec
434 : * write (6,*) 'avant segact mridec ',mridec
435 : segact mrigid
436 : mrigid=mricou
437 : * write (6,*) 'avant segact mricou ',mricou
438 : segact mrigid
438 : call fusrig(mridec,mricou,mrigid)
439 :
440 : 79 mlmots = idua
441 : mlmot1 = iinc
442 : segsup mlmots, mlmot1
443 :
444 : 80 continue
445 : IRET = MRIGID
446 :
447 : *
448 : END
449 :
450 :
451 :
© Cast3M 2003 - All rights reserved.
Disclaimer