1 : C MATCAR SOURCE FANDEUR 13/01/29 21:16:03 7683
2 : SUBROUTINE MATCAR(MONCAS)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Sous-programme associ{ @ l'op{rateur MATR et CARB *
8 : * __________________________________________________ *
9 : * *
10 : * Creation d'un champ de caract{ristiques mat{rielles et/ou *
11 : * g{om{triques. *
12 : * *
13 : * Commentaire : *
14 : * *
15 : * - En utilisant MATR : On est autorise a donner des caract{risti-*
16 : * ques materielles et geom{triques. *
17 : * MONCAS = 'MATERIAU' *
18 : * Toutes les autres composantes ne seront *
19 : * pas prises en comptes. *
20 : * *
21 : * - En utilisant CARB : On est autorise a donner des caract{risti-*
22 : * ques g{om{triques. *
23 : * MONCAS = 'CARACTER' *
24 : * Toutes les autres composantes ne seront *
25 : * pas prise en comptes. *
26 : * *
27 : * Remarque importante: *
28 : * *
29 : * Un certain nombre de composantes par d{faut est requis lors *
30 : * d'un processus de calcul. Il est possible d'en d{finir d'autres *
31 : * @ la convenance de l'utilisateur.(l'appel a matcar devra alors *
32 : * se faire avec MONCAS <> 'CARACTER' et MONCAS <> 'MATERIAU' *
33 : * *
34 : * Auteur, date de cr{ation: *
35 : * ------------------------- *
36 : * *
37 : * Denis ROBERT-MOUGIN, le 21 d{cembre 1987. *
38 : * *
39 : * - Mise a niveau avec MATE pour les mat{riaux ORTHOTROPES par : *
40 : * jm CAMPENON le 29 08 90 *
41 : * *
42 : * - Autoriser uniquement la prise en compte des : *
43 : * - carac. geom. quand provenance de CARB (MONCAS = 'CARACTER') *
44 : * - carac. geom. et mat{r. quand provenance de MATR *
45 : * (MONCAS = 'MATERIAU') *
46 : * jm CAMPENON le 23 10 90 *
47 : * if (im.lt.mlo) goto 10
48 :
49 : * -MISE A NIVEAU POUR L'ANISOTROPIE ET L'ORTHOTROPIE DANS LES *
50 : * ELEMENTS MASSIFS PAR P. DOWLATYARI OCT. 90 *
51 : *--------------------------------------------------------------------*
52 : *
53 : -INC CCOPTIO
54 : *-
55 : -INC CCREEL
56 : -INC CCHAMP
57 : -INC SMLMOTS
58 : -INC SMLREEL
59 : -INC SMLENTI
60 : -INC SMMODEL
61 : -INC SMLCHPO
62 : -INC SMTABLE
63 : -INC SMELEME
64 :
65 : * MOMATR pointera sur la liste des caract{ristiques mat{rielles
66 : * MOCARA pointera sur la liste des caract{ristiques g{om{triques
67 : *
68 : PARAMETER ( JER1=16 )
69 : REAL*8 RECOM
70 : LOGICAL RFLAG,lsupma,lsupca
71 : CHARACTER*4 MOPER,MOCHOI
72 : CHARACTER*8 CMO,CAR,MONCAS,MOBUF,CMATE
73 : CHARACTER*16 LETYP
74 : LOGICAL L0,L1
75 : CHARACTER*8 TYPRET,CHARRE
76 : *
77 : *
78 : * MONCAS='MATERIAU' --> IFLAG=1 (SEULEMENT LES CARAC. G{OM. ET
79 : * MAT{R. : MATR)
80 : * MONCAS='CARACTER' --> IFLAG=2 (SEULEMENT LES CARAC. G{OM. : CARB)
81 : * IFLAG=0 tous les noms composantes voulues
82 : *
83 : IFLAG=0
84 : IF (MONCAS.EQ.'CARACTER') IFLAG=2
85 : IF (MONCAS.EQ.'MATERIAU') IFLAG=1
86 : *
87 : * Lecture d'un MODELE (comme c'est un nouveau, le type est MMODEL)
88 : *
89 : MOTERR(1:8)=' MODELE '
89 : CALL MESLIR(-137)
89 : CALL LIROBJ('MMODEL',IPMODE,1,IRET)
90 : IF (IERR.NE.0) RETURN
91 : *
92 : * Initialisation des segments
93 : *
94 : JG=0
95 : JGN=4
96 : JGM=0
97 : SEGINI,MLMOTS
98 : SEGINI,MLMOT1
99 : SEGINI,MLMOT2
100 : SEGINI,MLMOT3
101 : SEGINI,MLREE1
102 : SEGINI,MLENT2
103 : *
104 : NUDIR1=0
105 : NUDIR2=0
106 : NUMP1=0
107 : NUMP2=0
108 : NUMP3=0
109 : ANG=0.D0
110 : IPLIQU=0
111 : IRACOR=0
112 : ICARA=0
113 : ITHER=0
114 : ICONV=0
115 : ICONTA=0
116 : IMELA = 0
117 : ILIMA = 0
118 : ICOUD=0
119 : RFLAG = .FALSE.
120 : ITBAS = 0
121 : ITMOD = 0
122 : *
123 : MMODEL=IPMODE
124 : SEGACT,MMODEL
125 : N1=KMODEL(/1)
126 : *
127 : IMODEL=KMODEL(1)
128 : SEGACT IMODEL*NOMOD
129 : NFOR=FORMOD(/2)
130 : NMAT=MATMOD(/2)
131 : IF (FORMOD(1).NE.'CONVECTION') THEN
131 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
132 : IF (CMATE.EQ.' ') THEN
132 : CALL ERREUR(251)
133 : RETURN
134 : ENDIF
135 : ELSE
136 : MATE=1
137 : ENDIF
138 : IF(NFOR.EQ.2)THEN
139 : IF((FORMOD(1).EQ.'MECANIQUE '.AND.
140 : 1 FORMOD(2).EQ.'LIQUIDE ').OR.
141 : 2 (FORMOD(1).EQ.'LIQUIDE '.AND.
142 : 3 FORMOD(2).EQ.'MECANIQUE '))IRACOR=1
143 : ENDIF
144 : *
144 : CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
144 : CALL PLACE(FORMOD,NFOR,ICONV,'CONVECTION')
144 : CALL PLACE(FORMOD,NFOR,ICONTA,'CONTACT')
144 : CALL PLACE(FORMOD,NFOR,IMELA,'MELANGE')
144 : CALL PLACE(FORMOD,NFOR,ILIMA,'LIAISON_MATERIELLE')
145 : *
146 : C= Element fini et formulation associee
147 : C= En DIMEnsion 1, on force formulation MASSIVE pour les elements POI1
148 : C= (utilises en convection et en rayonnement).
149 : MELE=NEFMOD
150 : MFR1=NUMMFR(MELE)
151 : IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR1=1
152 : *
153 : if(lnomid(6).ne.0.and.imela.eq.0) then
154 : nomid=lnomid(6)
155 : segact nomid
156 : momatr=nomid
157 : nbrmat=lesobl(/2)
158 : nbrmatf=lesfac(/2)
159 : lsupma=.false.
160 : * write(6,*) ' matcar ' , (lesobl(iou),iou=1,nbrmat)
160 : * CALL IDMATR(MFR1,IMODEL,MOMATR,NBRMAT,NBRMATF)
161 : * nomid = momatr
162 : * segact nomid
163 : * write(6,*) ' matcar bis ' , (lesobl(iou),iou=1,nbrmat)
164 : else
165 : lsupma=.true.
165 : CALL IDMATR(MFR1,IMODEL,MOMATR,NBRMAT,NBRMATF)
166 : endif
167 : IF(MOMATR.EQ.0) THEN
168 : MOTERR(1:4)='MATE'
169 : MOTERR(5:8)=NOMTP(MELE)
169 : CALL ERREUR(76)
170 : GO TO 99
171 : ENDIF
172 : *
173 : NOMID=MOMATR
174 : SEGACT NOMID
175 : if(lnomid(7).ne.0) then
176 : nomid=lnomid(7)
177 : segact nomid
178 : mocara=nomid
179 : nbrcar=lesobl(/2)
180 : nbrcarf=lesfac(/2)
181 : lsupca=.false.
182 : else
183 : lsupca=.true.
183 : CALL IDCARB(MELE,IFOUR,MOCARA,NBRCAR,NBRCARF)
184 : endif
185 : NOMID=MOCARA
186 : SEGACT NOMID
187 : *
188 : IMIL = 1
189 : 10 CONTINUE
189 : IF (IMIL.EQ.0) CALL MESLIR(-175)
190 : INCM1 = 0
191 : INCM2 = 0
192 : INCM3 = 0
193 : INCM4 = 0
194 : *
195 : IRBUF = 0
196 : IRCHOI = 0
197 : *
197 : CALL LIRCHA(MOBUF,0,IRBUF)
198 : MOBUF=MOBUF(1:4)
199 : IF (IRBUF.EQ.0) GOTO 20
200 : *
201 : NOMID=MOMATR
201 : CALL PLACE(LESOBL,LESOBL(/2),INCM1,MOBUF)
202 : IF (INCM1.NE.0) GOTO 120
203 : *
204 : NOMID=MOMATR
204 : CALL PLACE(LESFAC,LESFAC(/2),INCM3,MOBUF)
205 : IF (INCM3.NE.0) GOTO 120
206 : *
207 : NOMID=MOCARA
207 : CALL PLACE(LESOBL,LESOBL(/2),INCM2,MOBUF)
208 : IF (INCM2.NE.0) GOTO 120
209 : *
210 : NOMID=MOCARA
210 : CALL PLACE(LESFAC,LESFAC(/2),INCM4,MOBUF)
211 : IF (INCM4.NE.0) GOTO 120
212 : *
213 :
214 : MOCHOI=MOBUF
215 : IRCHOI=IRBUF
216 : *
217 : *
218 : 120 CONTINUE
219 : IF (IERR.NE.0) GO TO 99
220 : IMIL=0
221 : *
222 : * PETIT TEST POUR COQ3 NON EXCENTRABLE MILL 21 / 2 /92
223 : *
224 : IF((MELE.EQ.27.AND.MFR1.EQ.3).AND.MOBUF.EQ.'EXCE') THEN
224 : CALL ERREUR(474)
225 : GO TO 99
226 : ENDIF
227 : *
228 : * On d{sire lire une composante "quelconque":
229 : *
230 : IF(INCM1.EQ.0.AND.INCM2.EQ.0.AND.INCM3.EQ.0.AND.INCM4.EQ.0)THEN
231 : IF (MOCHOI.EQ.'PARA'.AND.IRCHOI.NE.0) THEN
232 : NUDIR2=1
233 : GOTO 10
234 : ENDIF
235 : IF (MOCHOI.EQ.'PERP'.AND.IRCHOI.NE.0) THEN
236 : NUDIR2=2
237 : GOTO 10
238 : ENDIF
239 : ENDIF
240 : *
241 : * kich test mot cle
242 : *
243 : IF (MOBUF.EQ.'REND'.AND.IRBUF.NE.0) THEN
244 : RFLAG = .TRUE.
245 : ENDIF
246 : *
247 : * Lecture {ventuelle d'un flottant
248 : *
248 : CALL LIRREE(RECOM,0,IRET2)
249 : IF (IRET2.EQ.1) THEN
250 : *
251 : * kich rendement cas isotrope
252 : *
253 : IF (RFLAG.AND.MOBUF.EQ.'REND'.AND.IRBUF.NE.0) RFLAG = .FALSE.
254 : *
255 : * Dans le cas ou on lit le mot incline on peut eventuellement trouver
256 : * en plus de l'angle un point donnant la direction de la normal
257 : * exterieur @ la coque
258 : *
259 : IF (MOCHOI.EQ.'INCL'.AND.IRCHOI.NE.0) THEN
260 : NUDIR2=3
261 : ANG=RECOM*XPI/180.D0
262 : IF((IDIM.EQ.3.AND.MFR1.EQ.3).OR.MFR1.EQ.9.OR.
263 : . MFR1.EQ.5.OR.(IDIM.EQ.3.AND.MFR1.EQ.35))THEN
263 : CALL LIROBJ('POINT',NUMP3,1,IRET)
264 : IF (IERR.NE.0) GOTO 99
265 : ENDIF
266 : GOTO 10
267 : ENDIF
268 : IF (IFLAG.NE.2) THEN
269 : NOMID=MOMATR
270 : IF (INCM1.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM1)
271 : IF (INCM3.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM3)
272 : ELSE
273 : IF (INCM1.NE.0) THEN
274 : MOTERR(1:4)=LESOBL(INCM1)
274 : CALL ERREUR (197)
275 : GOTO 99
276 : ELSE
277 : IF (INCM3.NE.0) THEN
278 : MOTERR(1:4)=LESFAC(INCM3)
278 : CALL ERREUR (197)
279 : GOTO 99
280 : ENDIF
281 : ENDIF
282 : ENDIF
283 : *
284 : NOMID=MOCARA
285 : IF (INCM2.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM2)
286 : IF (INCM4.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM4)
287 : *
288 : IF (IFLAG.EQ.0) THEN
289 : IF (IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI
290 : ELSE
291 : IF (IRCHOI.NE.0) THEN
292 : MOTERR(1:4)=MOCHOI
292 : CALL ERREUR (197)
293 : GOTO 99
294 : ENDIF
295 : ENDIF
296 : *
297 : JG=MLREE1.PROG(/1)+1
298 : SEGADJ MLREE1
299 : MLREE1.PROG(JG)=RECOM
300 : ELSE
300 : CALL QUETYP(CAR,0,IRET1)
301 : IF (IERR.NE.0) GO TO 99
302 : IF (RFLAG) THEN
303 : IF (CAR.EQ.'MOT ') THEN
304 : GOTO 10
305 : ELSE
306 : * kich matrice rendement
307 : IF (MOCHOI.EQ.'REND'.AND.IRCHOI.NE.0) RFLAG = .FALSE.
308 : ENDIF
309 : ENDIF
309 : CALL LIROBJ(CAR,IPTRUC,0,IRET1)
310 : IF (IERR.NE.0) GO TO 99
311 : *
312 : * On a lu un objet de type autre qu' un flottant
313 : *
314 : IF(IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU'
315 : 1 .AND.IRCHOI.NE.0)THEN
316 : IF(CAR.NE.'MAILLAGE')THEN
317 : MOTERR(1:8)='MAILLAGE'
317 : CALL ERREUR(37)
318 : GOTO 99
319 : ELSE
320 : IPLIQU=IPTRUC
321 : GOTO 10
322 : ENDIF
323 : ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0) THEN
324 : IF (MATE.NE.2.AND.MATE.NE.3.AND.MATE.NE.4.
325 : &AND..NOT.RFLAG) THEN
325 : CALL ERREUR(728)
326 : GOTO 99
327 : ENDIF
328 : IF(CAR.NE.'POINT')THEN
329 : MOTERR(1:8)='POINT'
329 : CALL ERREUR(37)
330 : GOTO 99
331 : ELSE
332 : NUDIR1=1
333 : NUMP1=IPTRUC
334 : ENDIF
335 : *
336 : * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
337 : *
338 : IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
339 : & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
340 : S .AND. IDIM.EQ.3) THEN
340 : CALL LIROBJ(CAR,NUMP2,0,IRET)
341 : IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
342 : ENDIF
343 : GOTO 10
344 : ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0) THEN
345 : IF(CAR.NE.'POINT')THEN
346 : MOTERR(1:8)='POINT'
346 : CALL ERREUR(37)
347 : GOTO 99
348 : ELSE
349 : NUDIR1=2
350 : NUMP1=IPTRUC
351 : ENDIF
352 : *
353 : * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
354 : *
355 : IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR.
356 : & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
357 : S .AND. IDIM.EQ.3) THEN
357 : CALL LIROBJ(CAR,NUMP2,0,IRET)
358 : IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
359 : ENDIF
360 : GOTO 10
361 : ENDIF
362 : *
363 : IF (IFLAG.NE.2) THEN
364 : NOMID=MOMATR
365 : IF (INCM1.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM1)
366 : IF (INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
367 : ELSE
368 : IF (INCM1.NE.0) THEN
369 : MOTERR(1:4)=LESOBL(INCM1)
369 : CALL ERREUR (197)
370 : GOTO 99
371 : ELSE
372 : IF (INCM3.NE.0) THEN
373 : MOTERR(1:4)=LESFAC(INCM3)
373 : CALL ERREUR (197)
374 : GOTO 99
375 : ENDIF
376 : ENDIF
377 : ENDIF
378 : *
379 : NOMID=MOCARA
380 : IF (INCM2.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM2)
381 : IF (INCM4.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM4)
382 : *
383 : IF (IFLAG.EQ.0) THEN
384 : IF (IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI
385 : ELSE
386 : IF (IRCHOI.NE.0) THEN
387 : MOTERR(1:4)=MOCHOI
387 : CALL ERREUR (197)
388 : GOTO 99
389 : ENDIF
390 : ENDIF
391 : *
392 :
393 : JGM = MLMOT3.MOTS(/2)
394 : MLMOT3.MOTS(**)=CAR(1:4)
395 : MOTS(**) =CAR(5:8)
396 : JG=MLENT2.LECT(/1)+1
397 : SEGADJ MLENT2
398 : MLENT2.LECT(JG)=IPTRUC
399 : ENDIF
400 : GOTO 10
401 : * END DO
402 : *
403 : 20 CONTINUE
404 : *
405 : * DANS LE CAS DES TUYAUX 3D ,ON REGARDE SI LES CARACTERISTIQUES
406 : * GEOMETRIQUES ONT ETE DONNEES ,SI OUI ON VERIFIE SI ON EST
407 : * DANS LE CAS DES COUDES
408 : *
409 : IF(MFR1.EQ.13.AND.IDIM.EQ.3)THEN
409 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'RAYO')
410 : IF(IGEO.NE.0)THEN
410 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICOUD,'RACO')
411 : ENDIF
412 : ENDIF
413 : *
414 : * DANS LE CAS DES POUTRES 3D ,ON REGARDE SI LES CARACTERISTIQUES
415 : * GEOMETRIQUES ONT ETE DONNEES
416 : *
417 : IF(MFR1.EQ.7.AND.((IDIM.EQ.3).OR.(IDIM.EQ.2)))THEN
417 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT')
418 : ENDIF
419 :
420 : *
421 : * TRAITEMENT MODELE DDI
422 : *
423 : IF(INAT.EQ.63) THEN
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP1,'DP1')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP2,'DP2')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV1,'DV1')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV2,'DV2')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP1,'CP1')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP2,'CP2')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV1,'CV1')
423 : CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV2,'CV2')
424 :
425 : IF((MLREE1.PROG(ICP1).EQ.0.D0).AND.(MLREE1.PROG(IDP1).NE.0.D0))
426 : & THEN
426 : CALL ERREUR(906)
427 : RETURN
428 : ENDIF
429 : IF((MLREE1.PROG(ICP2).EQ.0.D0).AND.(MLREE1.PROG(IDP2).NE.0.D0))
430 : & THEN
430 : CALL ERREUR(906)
431 : RETURN
432 : ENDIF
433 : IF((MLREE1.PROG(ICV1).EQ.0.D0).AND.(MLREE1.PROG(IDV1).NE.0.D0))
434 : & THEN
434 : CALL ERREUR(906)
435 : RETURN
436 : ENDIF
437 : IF((MLREE1.PROG(ICV2).EQ.0.D0).AND.(MLREE1.PROG(IDV2).NE.0.D0))
438 : & THEN
438 : CALL ERREUR(906)
439 : RETURN
440 : ENDIF
441 :
442 : ENDIF
443 : *
444 : IF((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR.
445 : 1 MLMOT1.MOTS(/2).NE.0.OR.MLMOT2.MOTS(/2).NE.0)THEN
446 : *
447 : IF(ITHER.EQ.0.AND.ICONV.EQ.0.AND.ICONTA.EQ.0) THEN
448 : ISUP=3
449 : ELSE IF(ICONTA.NE.0) THEN
450 : ISUP=1
451 : ELSE
452 : ISUP=6
453 : ENDIF
454 : LETYP ='CARACTERISTIQUES'
455 : itart=0
455 : CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
456 : & MLENT2,LETYP,JER1,ISUP,ICARA,itart)
457 : IF (IERR.NE.0) GO TO 99
458 : ENDIF
459 : *
460 : * TRAITEMENT POUR LES ELEMENTS RACCORDS FLUIDE/STRUCTURE
461 : *
462 : IF(IRACOR.NE.0.AND.IPLIQU.NE.0)THEN
462 : CALL VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
463 : IF(IERR.NE.0)GOTO 99
464 : ENDIF
465 : *
466 : * TRAITEMENT PARTICULIER POUR LES POUTRES ET TUYAUX
467 : * PB DU VECTEUR LOCAL - MILL FEV 92
468 : *
469 : IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0))
470 : & .AND.IGEO.NE.0.AND.IDIM.EQ.3)THEN
470 : CALL POUVLO(IPMODE,MLMOT2,ISUP,ICARA)
471 : IF(IERR.NE.0) GO TO 99
472 : ENDIF
473 : *
474 : * Traitement pour les mat{riaux orthotropes
475 : *
476 : C= Dans le cas IDIM=1, on ne traite pas les mots cles PARA,DIRE,PERP...
477 : C= car les directions d'orthotropie correspondent au repere global
478 : IF (IFLAG.NE.2.and.formod(1).ne.'MELANGE'.and.nefmod.ne.45)
479 : &THEN
480 : IF (IDIM.NE.1) THEN
480 : CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2,
481 : . NUMP3,ANG,IPCARA,RFLAG)
482 : IF (IERR.NE.0) GO TO 99
483 : IF (IPCARA.NE.0) THEN
483 : CALL DTCHAM(ICARA)
484 : ICARA=IPCARA
485 : ENDIF
486 : ENDIF
487 : ENDIF
488 : *
489 : * MODAL - traitement direct à partir de la table BASE MODALE
490 : *
491 : IF (nefmod.eq.45.and.MFR1.EQ.27.and.icara.eq.0) THEN
492 :
493 : if (itbas.eq.0) then
493 : CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
494 : IF (IRETOU.NE.0) THEN
494 : CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',L0,IP0,
495 : & 'TABLE',I1,X1,CHARRE,L1,ITMOD)
496 : itbas = itmod
497 : ELSE
497 : CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
498 : ENDIF
499 : endif
500 :
501 : jg = 0
502 : segini mlreel,mlree1,mlree2,mlenti,mlent2
503 : n1 = 1
504 : segini mlchpo,mmode1
505 :
506 : do 49 ii = 1, kmodel(/1)
507 : IMODEL=KMODEL(ii)
508 : mmode1.kmodel(1) = imodel
509 : segact imodel
510 : meleme = imamod
511 : segact meleme
512 : do 48 jj = 1,num(/2)
513 : ipoi1 = num(1,jj)
514 :
515 : * de quel mode s agit-il ?
516 : mtable = itbas
517 : segact mtable
518 : mlo = mlotab
519 : IM = 0
520 : 40 CONTINUE
521 : IM = IM + 1
522 : TYPRET = ' '
522 : CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
523 : & TYPRET,I1,X1,CHARRE,L1,ITMOD)
524 : IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
524 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
525 : & 'POINT',I1,X1,' ',L1,IPTS)
526 : if (ipts.eq.ipoi1) goto 45
527 : ENDIF
528 : if (im.lt.mlo) goto 40
529 : interr(1) = ipoi1
530 : * pas trouve de caracteristiques pour le point support
530 : call erreur(3)
531 : return
532 :
533 : 45 continue
534 :
534 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
535 : & 'FLOTTANT',I1,XFREQ,' ',L1,IP1)
536 : mlree1.prog(**)= xfreq
536 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
537 : & 'FLOTTANT',I1,XMGEN,' ',L1,IP1)
538 : mlree2.prog(**)= xmgen
538 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
539 : & 'CHPOINT ',I1,X1,' ',L1,ITDEPL)
540 : lect(**) = itdepl
541 : 48 continue
542 :
543 : segdes imodel,meleme
544 : 49 continue
545 : NOMID=MOMATR
546 : * voir aussi idmatr
547 : MLMOT2.MOTS(**) = 'FREQ'
548 : MLMOT2.MOTS(**) = 'MASS'
549 : MLMOT2.MOTS(**) = 'DEFO'
550 : * IF (INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3)
551 : JG=MLENT2.LECT(/1)+3
552 : SEGADJ MLENT2
553 : MLENT2.LECT(JG-2) = mlree1
554 : MLENT2.LECT(JG-1) = mlree2
555 : MLENT2.LECT(JG) = mlenti
556 :
557 : MLMOT3.MOTS(**)='LIST'
558 : MOTS(**) ='REEL'
559 : MLMOT3.MOTS(**)='LIST'
560 : MOTS(**) ='REEL'
561 : MLMOT3.MOTS(**)='CHPO'
562 : MOTS(**) ='INT '
563 :
564 : ISUP=3
565 :
566 : LETYP ='CARACTERISTIQUES'
567 : itart=1
567 : CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL,
568 : & MLENT2,LETYP,JER1,ISUP,ICARA,itart)
569 : IF (IERR.NE.0) GO TO 99
570 : segsup mlreel,mlent2
571 : ENDIF
572 : *
573 : 99 CONTINUE
574 :
575 : * Suppression des segments
576 : *
577 : SEGSUP,MLMOTS
578 : SEGSUP,MLMOT1
579 : SEGSUP,MLMOT2
580 : SEGSUP,MLMOT3
581 : SEGSUP,MLREE1
582 : SEGSUP,MLENT2
583 : *
583 : IF(IERR.EQ.0)CALL ECROBJ('MCHAML',ICARA)
584 : *
585 : NOMID=MOMATR
586 : IF(NOMID.NE.0.and.lsupma) SEGSUP NOMID
587 : NOMID=MOCARA
588 : IF(NOMID.NE.0.and.lsupca) SEGSUP NOMID
589 : *
590 : * D{sactivation des segments
591 : *
592 : DO 68 I=1,N1
593 : IMODEL=KMODEL(I)
594 : SEGDES,IMODEL
595 : * END DO
596 : 68 CONTINUE
597 : SEGDES,MMODEL
598 : *
599 : RETURN
600 : END
601 :
602 :
603 :
604 :
605 :
606 :
607 :
© Cast3M 2003 - All rights reserved.
Disclaimer