1 : C COPBAS SOURCE PV 09/03/12 21:18:16 6325
2 : SUBROUTINE COPBAS(ITBAS,ITPTS,MOTCLE,IPO1,IPO2,XANG)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,Q-Z)
5 : LOGICAL L0,L1
6 : *--------------------------------------------------------------------*
7 : * *
8 : * Effectue une op{ration g{om{trique de translation (MOTCLE = *
9 : * 'PLUS') ou de rotation (MOTCLE = 'ROTA') sur ITBAS contenant *
10 : * les modes, les pseudo-modes de la structure. *
11 : * *
12 : * Param}tres: *
13 : * *
14 : * e ITBAS table de sous-type BASE_MODALE, contenant les modes, *
15 : * les pseudo-modes,... de la structure *
16 : * e ITPTS table de sous-type POINT, points de la g{om{trie que *
17 : * l'on souhaite translat{s *
18 : * e MOTCLE mot : PLUS ou ROTA *
19 : * e IPO1 premier point de l'axe de rotation *
20 : * e IPO2 deuxi}me point de l'axe de rotation, si 3D *
21 : * e XANG angle de rotation *
22 : * *
23 : * Auteur, date de cr{ation: *
24 : * *
25 : * Lionel VIVAN, le 9 mai 1990. *
26 : * *
27 : *--------------------------------------------------------------------*
28 : * *
29 : -INC CCOPTIO
30 : -INC SMCHPOI
31 : -INC SMCHAML
32 : -INC SMCOORD
33 : -INC SMELEME
34 : -INC SMTABLE
35 : *
36 : logical ltelq
37 : SEGMENT ITRCHP
38 : INTEGER ICHCA(NSOU),ICHCN(NSOU)
39 : ENDSEGMENT
40 : SEGMENT ITRCHA
41 : INTEGER ICHAM(NSOUS)
42 : ENDSEGMENT
43 : SEGMENT MTRAV
44 : REAL*8 XPT(IDIMB),XPTP(IDIMB),XP1PT(IDIMB),XMPT(IDIMB,IDIMB)
45 : ENDSEGMENT
46 : SEGMENT MTRA2
47 : INTEGER IDEP(3),IROT(3)
48 : REAL*8 XDEP(3),XROT(3)
49 : ENDSEGMENT
50 : SEGMENT MTRA3
51 : REAL*8 XDGEN(3),XDGE2(3)
52 : ENDSEGMENT
53 : SEGMENT MTRA4
54 : INTEGER IFOR(3),IMOM(3)
55 : REAL*8 XFOR(3),XMOM(3)
56 : ENDSEGMENT
57 : *
58 : * LCHAIN contiendra les adresses des cha™nes dans CCNOYAU
59 : *
60 : PARAMETER ( NCHAIN = 19 )
61 : INTEGER LCHAIN(NCHAIN)
62 : CHARACTER*4 COMP,MOTCLE
63 : CHARACTER*8 TYPRET,CHARRE
64 : *
64 : CALL CRTABL(ITBID)
65 : *
66 : ICHAIN = 1
66 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
67 : & 'POINT_REPERE',L1,IP1)
68 : ICHAIN = 2
68 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
69 : & 'DEPLACEMENTS_GENERALISES',L1,IP1)
70 : ICHAIN = 3
70 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
71 : & 'DEFORMEE_MODALE',L1,IP1)
72 : ICHAIN = 4
72 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
73 : & 'CONTRAINTE_MODALE',L1,IP1)
74 : ICHAIN = 5
74 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
75 : & 'REACTION_MODALE',L1,IP1)
76 : ICHAIN = 6
76 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
77 : & 'DEPLACEMENT',L1,IP1)
78 : ICHAIN = 7
78 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
79 : & 'CONTRAINTE',L1,IP1)
80 : ICHAIN = 8
80 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
81 : & 'REACTION',L1,IP1)
82 : ICHAIN = 9
82 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
83 : & 'CHAMP_BASE_B',L1,IP1)
84 : ICHAIN = 10
84 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
85 : & 'POINT',L1,IP1)
86 : ICHAIN = 11
86 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
87 : & 'MODES',L1,IP1)
88 : ICHAIN = 12
88 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
89 : & 'PSEUDO_MODES',L1,IP1)
90 : ICHAIN = 13
90 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
91 : & 'MAILLAGE',L1,IP1)
92 : ICHAIN = 14
92 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
93 : & 'SOUSTYPE',L1,IP1)
94 : ICHAIN = 15
94 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
95 : & 'BASE_MODALE',L1,IP1)
96 : ICHAIN = 16
96 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
97 : & 'BASE_ROTA',L1,IP1)
98 : ICHAIN = 17
98 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
99 : & 'BASE_PLUS',L1,IP1)
100 : ICHAIN = 18
100 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
101 : & 'BASE',L1,IP1)
102 : ICHAIN = 19
102 : CALL ECCTAB(ITBID,'ENTIER',ICHAIN,X0,' ',L0,IP0,'MOT',I1,X1,
103 : & 'MASSE_GENERALISEE',L1,IP1)
104 : *
105 : MTABLE = ITBID
106 : SEGACT,MTABLE
107 : DO 20 ICHAIN = 1 , NCHAIN
108 : LCHAIN(ICHAIN) = MTABIV(ICHAIN)
109 : 20 CONTINUE
110 : * end do
111 : SEGSUP,MTABLE
112 : *
113 : * R{cup{ration de la table des modes
114 : *
115 : MTABLE = ITBAS
116 : SEGACT MTABLE
117 : LONG = MLOTAB
118 : DO 10 I = 1,LONG
119 : IF (MTABTI(I).EQ.'MOT ' .AND.
120 : & MTABII(I).EQ.LCHAIN(11) .AND.
121 : & MTABTV(I).EQ.'TABLE ') THEN
122 : IBAS = MTABIV(I)
123 : GOTO 12
124 : ENDIF
125 : 10 CONTINUE
126 : * end do
126 : CALL ERREUR(499)
127 : SEGDES MTABLE
128 : RETURN
129 : 12 CONTINUE
130 : *
131 : * R{cup{ration de la table des pseudo-modes
132 : *
133 : IPSM = 0
134 : DO 14 I = 1,LONG
135 : IF (MTABTI(I).EQ.'MOT ' .AND.
136 : & MTABII(I).EQ.LCHAIN(12) .AND.
137 : & MTABTV(I).EQ.'TABLE ') THEN
138 : IPSM = MTABIV(I)
139 : GOTO 16
140 : ENDIF
141 : 14 CONTINUE
142 : * end do
143 : 16 CONTINUE
144 : SEGDES MTABLE
145 : *
146 : KTRAV = 0
147 : IF (MOTCLE.EQ.'ROTA') THEN
148 : IDIM1 = IDIM + 1
148 : CALL CALMAT(KTRAV,IPO1,IPO2,XANG)
149 : IF (IERR.NE.0) RETURN
150 : MTRAV = KTRAV
151 : ENDIF
152 : *
153 : * Traitement de la table de modes
154 : * ===============================
155 : *
156 : * On duplique la table des modes
157 : *
157 : CALL COPBA2(LCHAIN,IBAS,IBA2)
158 : *
159 : * On r{cup}re la premi}re d{form{e modale pour cr{er le nouveau
160 : * maillage.
161 : *
162 : MTABLE = IBA2
163 : SEGACT MTABLE*MOD
164 : LONG = MLOTAB
165 : IM = 1
166 : DO 60 I = 1,LONG
167 : IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
168 : & MTABTV(I).EQ.'TABLE ') THEN
169 : ITMOD = MTABIV(I)
170 : GOTO 62
171 : ENDIF
172 : 60 CONTINUE
173 : * end do
173 : CALL ERREUR(500)
174 : SEGDES MTABLE
175 : RETURN
176 : 62 CONTINUE
177 : MTAB1 = ITMOD
178 : SEGACT MTAB1*MOD
179 : LON1 = MTAB1.MLOTAB
180 : DO 64 I1 = 1,LON1
181 : IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
182 : & MTAB1.MTABII(I1).EQ.LCHAIN(3) .AND.
183 : & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
184 : ICHDEP = MTAB1.MTABIV(I1)
185 : GOTO 66
186 : ENDIF
187 : 64 CONTINUE
188 : * end do
188 : CALL ERREUR(501)
189 : SEGDES MTAB1
190 : SEGDES MTABLE
191 : RETURN
192 : 66 CONTINUE
193 : *
194 : MCHPOI = ICHDEP
195 : SEGACT MCHPOI
196 : NSOU = IPCHP(/1)
197 : SEGINI ITRCHP
198 : KTRCHP = ITRCHP
199 : DO 80 INS = 1,NSOU
200 : MSOUPO = IPCHP(INS)
201 : SEGACT MSOUPO*MOD
202 : IF (MOTCLE.EQ.'PLUS') THEN
203 : MAIL1 = IGEOC
204 : ICHCA(INS) = MAIL1
204 : CALL ECROBJ('POINT ',IPO1)
204 : CALL ECROBJ('MAILLAGE',MAIL1)
204 : CALL PROPER(1)
205 : IF (IERR.NE.0) RETURN
205 : CALL LIROBJ('MAILLAGE',NOMA1,1,IRETOU)
206 : IF (IERR.NE.0) RETURN
207 : IGEOC = NOMA1
208 : ICHCN(INS) = NOMA1
209 : ELSE
210 : SEGINI MTRA2
211 : MPOVAL = IPOVAL
212 : SEGACT MPOVAL
213 : NPOIN = VPOCHA(/1)
214 : NCOM = VPOCHA(/2)
215 : DO 210 IP = 1,NPOIN
216 : ICD = 0
217 : ICR = 0
218 : DO 220 IC = 1,NCOM
219 : COMP = NOCOMP(IC)
220 : IF (COMP(1:1).EQ.'U') THEN
221 : ICD = ICD + 1
222 : IDEP(ICD) = IC
223 : XDEP(ICD) = VPOCHA(IP,IC)
224 : ELSE IF (COMP(1:1).EQ.'R') THEN
225 : ICR = ICR + 1
226 : IROT(ICR) = IC
227 : XROT(ICR) = VPOCHA(IP,IC)
228 : ENDIF
229 : 220 CONTINUE
230 : * end do
231 : DO 230 IDE = 1,ICD
232 : XVAL = 0.D0
233 : DO 232 ID2 = 1,ICD
234 : XVAL = XVAL + (XMPT(IDE,ID2) * XDEP(ID2))
235 : 232 CONTINUE
236 : * end do
237 : IC = IDEP(IDE)
238 : VPOCHA(IP,IC) = XVAL
239 : 230 CONTINUE
240 : * end do
241 : IF (IDIM.EQ.3) THEN
242 : DO 240 IRO = 1,ICR
243 : XVAL = 0.D0
244 : DO 242 IR2 = 1,ICR
245 : XVAL = XVAL + (XMPT(IRO,IR2) * XROT(IR2))
246 : 242 CONTINUE
247 : * end do
248 : IC = IROT(IRO)
249 : VPOCHA(IP,IC) = XVAL
250 : 240 CONTINUE
251 : * end do
252 : ENDIF
253 : 210 CONTINUE
254 : * end do
255 : SEGDES MPOVAL
256 : SEGSUP MTRA2
257 : MAIL1 = IGEOC
258 : ICHCA(INS) = MAIL1
259 : IPT1 = MAIL1
260 : SEGINI,MELEME=IPT1
261 : NOMA1 = MELEME
262 : NBE = NUM(/2)
263 : NBPT = XCOOR(/1) / IDIM1
264 : NBPTS = NBPT + NBE
265 : SEGADJ MCOORD
266 : DO 82 IP = 1,NBE
267 : IPT = NUM(IP,1)
267 : CALL EXCOO1(IPT,XP,YP,ZP,DP)
268 : NBPT1 = NBPT + 1
269 : XPT(1) = XP
270 : XPT(2) = YP
271 : IF (IDIM.EQ.3) XPT(3) = ZP
272 : DO 84 ID1 = 1,IDIM
273 : XVAL = 0.D0
274 : DO 86 ID2 = 1,IDIM
275 : XVAL = XVAL + (XMPT(ID1,ID2) * XPT(ID2))
276 : 86 CONTINUE
277 : * end do
278 : XPTP(ID1) = XVAL + XP1PT(ID1)
279 : 84 CONTINUE
280 : * end do
281 : XCOOR(NBPT * IDIM1 + 1) = XPTP(1)
282 : XCOOR(NBPT * IDIM1 + 2) = XPTP(2)
283 : IF (IDIM.EQ.3) XCOOR(NBPT * IDIM1 + 3) = XPTP(3)
284 : XCOOR(NBPT1 * IDIM1) = DP
285 : NUM(IP,1) = NBPT1
286 : NBPT = NBPT1
287 : 82 CONTINUE
288 : * end do
289 : SEGDES MELEME
290 : IGEOC = NOMA1
291 : ICHCN(INS) = NOMA1
292 : ENDIF
293 : SEGDES MSOUPO
294 : 80 CONTINUE
295 : * end do
296 : SEGDES MCHPOI
297 : MTAB1.MTABIV(I1) = ICHDEP
298 : *
299 : IMAIL = ICHCA(1)
300 : INOMA = ICHCN(1)
301 : DO 40 INS = 2,NSOU
302 : MAIL1 = ICHCA(INS)
303 : NOMA1 = ICHCN(INS)
304 : ltelq=.false.
304 : CALL FUSE(INOMA,NOMA1,INOM2,ltelq)
305 : INOMA = INOM2
305 : CALL FUSE(IMAIL,MAIL1,IMAI2,ltelq)
306 : IMAIL = IMAI2
307 : 40 CONTINUE
308 : * end do
309 : *
310 : ICONT = 0
311 : DO 90 I1 = 1,LON1
312 : IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
313 : & MTAB1.MTABII(I1).EQ.LCHAIN(4) .AND.
314 : & MTAB1.MTABTV(I1).EQ.'MCHAML ') THEN
315 : ICHCON = MTAB1.MTABIV(I1)
316 : ICONT = 1
317 : GOTO 92
318 : ENDIF
319 : 90 CONTINUE
320 : * end do
321 : 92 CONTINUE
322 : KTRCHA = 0
323 : IF (ICONT.EQ.1) THEN
324 : MCHELM = ICHCON
325 : SEGACT MCHELM*MOD
326 : NSOUS = IMACHE(/1)
327 : SEGINI ITRCHA
328 : KTRCHA = ITRCHA
329 : DO 94 IN = 1,NSOUS
330 : IPT1 = IMACHE(IN)
331 : SEGINI,MELEME=IPT1
332 : NBN = NUM(/1)
333 : NBE = NUM(/2)
334 : DO 96 IE = 1,NBE
335 : DO 98 IP = 1,NBN
336 : IPO = NUM(IP,IE)
336 : CALL BAPOIN(IMAIL,IPO,INOMA,INOPO)
337 : IF (IERR.NE.0) RETURN
338 : NUM(IP,IE) = INOPO
339 : 98 CONTINUE
340 : * end do
341 : 96 CONTINUE
342 : * end do
343 : SEGDES MELEME
344 : ICHAM(IN) = MELEME
345 : IMACHE(IN) = MELEME
346 : 94 CONTINUE
347 : * end do
348 : SEGDES MCHELM
349 : MTAB1.MTABIV(I1) = ICHCON
350 : ENDIF
351 : *
352 : IF (MOTCLE.EQ.'ROTA') THEN
353 : DO 400 I1 = 1,LON1
354 : IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
355 : & MTAB1.MTABII(I1).EQ.LCHAIN(2) .AND.
356 : & MTAB1.MTABTV(I1).EQ.'TABLE ') THEN
357 : ITDEPG = MTAB1.MTABIV(I1)
358 : GOTO 402
359 : ENDIF
360 : 400 CONTINUE
361 : * end do
361 : CALL ERREUR(502)
362 : SEGDES MTAB1
363 : SEGDES MTABLE
364 : RETURN
365 : 402 CONTINUE
366 : *
367 : SEGINI MTRA3
368 : MTAB2 = ITDEPG
369 : SEGACT MTAB2
370 : LON2 = MTAB2.MLOTAB
371 : IDG = 1
372 : DO 410 I2 = 1,LON2
373 : IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
374 : & MTAB2.MTABII(I2).EQ.IDG .AND.
375 : & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
376 : XDGEN(IDG) = MTAB2.RMTABV(I2)
377 : IDG = IDG + 1
378 : ENDIF
379 : 410 CONTINUE
380 : * end do
381 : DO 420 ID1 = 1,IDIM
382 : XVAL = 0.D0
383 : DO 422 ID2 = 1,IDIM
384 : XVAL = XVAL + (XMPT(ID1,ID2) * XDGEN(ID2))
385 : 422 CONTINUE
386 : * end do
387 : XDGE2(ID1) = XVAL
388 : 420 CONTINUE
389 : * end do
390 : IDG = 1
391 : DO 430 I2 = 1,LON2
392 : IF (MTAB2.MTABTI(I2).EQ.'ENTIER ' .AND.
393 : & MTAB2.MTABII(I2).EQ.IDG .AND.
394 : & MTAB2.MTABTV(I2).EQ.'FLOTTANT') THEN
395 : MTAB2.RMTABV(I2) = XDGE2(IDG)
396 : IDG = IDG + 1
397 : ENDIF
398 : 430 CONTINUE
399 : * end do
400 : SEGDES MTAB2
401 : MTAB1.MTABIV(I1) = ITDEPG
402 : SEGSUP MTRA3
403 : ENDIF
404 : *
405 : IREAC = 0
406 : DO 790 I1 = 1,LON1
407 : IF (MTAB1.MTABTI(I1).EQ.'MOT ' .AND.
408 : & MTAB1.MTABII(I1).EQ.LCHAIN(5) .AND.
409 : & MTAB1.MTABTV(I1).EQ.'CHPOINT ') THEN
410 : ICHREA = MTAB1.MTABIV(I1)
411 : IREAC = 1
412 : GOTO 792
413 : ENDIF
414 : 790 CONTINUE
415 : * end do
416 : 792 CONTINUE
417 : IF (IREAC.EQ.1) THEN
418 : MCHPOI = ICHREA
419 : SEGACT MCHPOI
420 : NSOU2 = IPCHP(/1)
421 : DO 722 INS = 1,NSOU2
422 : MSOUPO = IPCHP(INS)
423 : SEGACT MSOUPO*MOD
424 : IF (MOTCLE.EQ.'ROTA') THEN
425 : SEGINI MTRA4
426 : MPOVAL = IPOVAL
427 : SEGACT MPOVAL
428 : NPOI2 = VPOCHA(/1)
429 : NCOM2 = VPOCHA(/2)
430 : DO 710 IP = 1,NPOI2
431 : ICF = 0
432 : ICM = 0
433 : DO 720 IC = 1,NCOM2
434 : COMP = NOCOMP(IC)
435 : IF (COMP(1:1).EQ.'F') THEN
436 : ICF = ICF + 1
437 : IFOR(ICF) = IC
438 : XFOR(ICF) = VPOCHA(IP,IC)
439 : ELSE IF (COMP(1:1).EQ.'M') THEN
440 : ICM = ICM + 1
441 : IMOM(ICM) = IC
442 : XMOM(ICM) = VPOCHA(IP,IC)
443 : ENDIF
444 : 720 CONTINUE
445 : * end do
446 : DO 730 IFO = 1,ICF
447 : XVAL = 0.D0
448 : DO 732 IF2 = 1,ICF
449 : XVAL = XVAL + XMPT(IFO,IF2) * XFOR(IF2)
450 : 732 CONTINUE
451 : * end do
452 : IC = IFOR(IFO)
453 : VPOCHA(IP,IC) = XVAL
454 : 730 CONTINUE
455 : * end do
456 : IF (IDIM.EQ.3) THEN
457 : DO 740 IMO = 1,ICM
458 : XVAL = 0.D0
459 : DO 742 IM2 = 1,ICM
460 : XVAL = XVAL + XMPT(IMO,IM2) * XROT(IM2)
461 : 742 CONTINUE
462 : * end do
463 : IC = IMOM(IMO)
464 : VPOCHA(IP,IC) = XVAL
465 : 740 CONTINUE
466 : * end do
467 : ENDIF
468 : 710 CONTINUE
469 : * end do
470 : SEGDES MPOVAL
471 : SEGSUP MTRA4
472 : ENDIF
473 : IPT1 = IGEOC
474 : SEGINI,MELEME=IPT1
475 : NBE = NUM(/2)
476 : NBP = NUM(/1)
477 : DO 750 IE = 1,NBE
478 : DO 752 IP = 1,NBP
479 : IPTS = NUM(IP,IE)
479 : CALL BAPOIN(IMAIL,IPTS,INOMA,INOPT)
480 : IF (IERR.NE.0) RETURN
481 : NUM(IP,IE) = INOPT
482 : 752 CONTINUE
483 : * end do
484 : 750 CONTINUE
485 : * end do
486 : SEGDES MELEME
487 : IGEOC = MELEME
488 : SEGDES MSOUPO
489 : 722 CONTINUE
490 : * end do
491 : SEGDES MCHPOI
492 : MTAB1.MTABIV(I1) = ICHREA
493 : ENDIF
494 : *
495 : SEGDES MTAB1
496 : MTABIV(I) = ITMOD
497 : *
498 : * On range le maillage dans la nouvelle table de modes
499 : *
500 : DO 42 I = 1,LONG
501 : IF (MTABTI(I).EQ.'MOT ' .AND.
502 : & MTABII(I).EQ.LCHAIN(13) .AND.
503 : & MTABTV(I).EQ.'MAILLAGE') THEN
504 : MTABIV(I) = INOMA
505 : GOTO 44
506 : ENDIF
507 : 42 CONTINUE
508 : * end do
508 : CALL ERREUR(503)
509 : SEGDES MTABLE
510 : RETURN
511 : 44 CONTINUE
512 : *
513 : SEGDES MTABLE
514 : *
515 : IMODE = 2
515 : CALL COPBA3(IBA2,MOTCLE,IMODE,IMAIL,INOMA,LCHAIN,KTRCHP,KTRCHA,
516 : & KTRAV,ICONT)
517 : IF (IERR.NE.0) RETURN
518 : *
519 : * Normalisation des modes
520 : *
521 : IF (MOTCLE.EQ.'ROTA') THEN
521 : CALL NORMOD(IBA2,LCHAIN)
522 : ENDIF
523 : *
524 : * Traitement de la table de pseudo-modes
525 : * ======================================
526 : *
527 : * On duplique la table des pseudo-modes
528 : *
529 : IF (IPSM.NE.0) THEN
529 : CALL COPBA2(LCHAIN,IPSM,IPS2)
530 : IMODE = 1
530 : CALL COPBA3(IPS2,MOTCLE,IMODE,IMAIL,INOMA,LCHAIN,KTRCHP,
531 : & KTRCHA,KTRAV,ICONT)
532 : IF (IERR.NE.0) RETURN
533 : *
534 : * On projecte les champs base B sur la base modale
535 : *
535 : CALL COPBA4(IBA2,IPS2)
536 : ENDIF
537 : *
538 : SEGSUP ITRCHP
539 : IF (ICONT.EQ.1) SEGSUP ITRCHA
540 : IF (MOTCLE.EQ.'ROTA') THEN
541 : SEGSUP MTRAV
542 : ENDIF
543 : *
544 : * Cr{ation de la table de sous-type BASE_MODALE
545 : *
546 : IF (IPSM.EQ.0) THEN
547 : M = 2
548 : ELSE
549 : M = 3
550 : ENDIF
551 : SEGINI MTABLE
552 : ITBA2 = MTABLE
553 : MLOTAB = M
554 : MTABTI(1) = 'MOT '
555 : MTABII(1) = LCHAIN(14)
556 : MTABTV(1) = 'MOT '
557 : MTABIV(1) = LCHAIN(15)
558 : MTABTI(2) = 'MOT '
559 : MTABII(2) = LCHAIN(11)
560 : MTABTV(2) = 'TABLE '
561 : MTABIV(2) = IBA2
562 : IF (IPSM.NE.0) THEN
563 : MTABTI(3) = 'MOT '
564 : MTABII(3) = LCHAIN(12)
565 : MTABTV(3) = 'TABLE '
566 : MTABIV(3) = IPS2
567 : ENDIF
568 : SEGDES MTABLE
569 : *
570 : * Traitement de la table des points
571 : * =================================
572 : *
572 : CALL CRTABL(ITPT2)
573 : IF (MOTCLE.EQ.'PLUS') THEN
573 : CALL ECCTAB(ITPT2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
574 : & 'MOT',I1,X1,'POINT_PLUS',L1,IP1)
575 : ELSE
575 : CALL ECCTAB(ITPT2,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
576 : & 'MOT',I1,X1,'POINT_ROTA',L1,IP1)
577 : ENDIF
578 : IP = 0
579 : 50 CONTINUE
580 : IP = IP + 1
581 : TYPRET = ' '
581 : CALL ACCTAB(ITPTS,'ENTIER',IP,X0,' ',L0,IP0,
582 : & TYPRET,I1,X1,CHARRE,L1,IPTS)
583 : IF (IPTS.NE.0 .AND. TYPRET.EQ.'POINT ') THEN
583 : CALL BAPOIN(IMAIL,IPTS,INOMA,INOPT)
584 : IF (IERR.NE.0) RETURN
584 : CALL ECCTAB(ITPT2,'POINT',I0,X0,' ',L0,IPTS,
585 : & 'POINT',I1,X1,' ',L1,INOPT)
586 : GOTO 50
587 : ENDIF
588 : *
589 : * Cr{ation de la table de sortie
590 : *
591 : M = 3
592 : SEGINI MTABLE
593 : ITNOBA = MTABLE
594 : MLOTAB = 3
595 : MTABTI(1) = 'MOT '
596 : MTABII(1) = LCHAIN(14)
597 : MTABTV(1) = 'MOT '
598 : IF (MOTCLE.EQ.'PLUS') THEN
599 : MTABIV(1) = LCHAIN(17)
600 : ELSE
601 : MTABIV(1) = LCHAIN(16)
602 : ENDIF
603 : MTABTI(2) = 'MOT '
604 : MTABII(2) = LCHAIN(18)
605 : MTABTV(2) = 'TABLE '
606 : MTABIV(2) = ITBA2
607 : MTABTI(3) = 'MOT '
608 : MTABII(3) = LCHAIN(10)
609 : MTABTV(3) = 'TABLE '
610 : MTABIV(3) = ITPT2
611 : SEGDES MTABLE
612 : *
612 : CALL ECROBJ('TABLE ',ITNOBA)
613 : *
614 : END
615 :
616 :
617 :
© Cast3M 2003 - All rights reserved.
Disclaimer