Télécharger matcar.eso

Retour à la liste

Numérotation des lignes :

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

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