Télécharger matcar.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales