Télécharger idprim.eso

Retour à la liste

Numérotation des lignes :

idprim
  1. C IDPRIM SOURCE CB215821 24/04/12 21:16:22 11897
  2. C=======================================================================
  3. C= DEFINITION DES NOMS DE COMPOSANTES PRIMALES =
  4. C= ------------------------------------------- =
  5. C= =
  6. C= Entrees : =
  7. C= IPMODE Pointeur sur un MMODEL.KMODEL =
  8. C= MFR0 Numero de Formulation =
  9. C= - Sert seulement si different de celui calcule avec IMODEL =
  10. C= =
  11. C= Sorties : =
  12. C= IPNOMC pointeur de type NOMID sur les listes de noms de =
  13. C= composantes OBLigatoires et FACultatives =
  14. C= NBROBL Nombre de composantes OBLIGATOIRES =
  15. C= NBRFAC Nombre de composantes FACULTATIVES =
  16. C=======================================================================
  17.  
  18. SUBROUTINE IDPRIM(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
  19.  
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. CHARACTER*16 NOM16
  24. EXTERNAL LONG
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMMODEL
  29. -INC SMLMOTS
  30.  
  31. CHARACTER*(LOCOMP) CCOMP
  32.  
  33. NOMID =0
  34. NBROBL=0
  35. NBRFAC=0
  36. IMODEL=IPMODE
  37. C Recuperation de IFOUR dans CCOPTIO.INC
  38. IFOU = IFOUR
  39. MELE =NEFMOD
  40. MFR =NUMMFR(MELE)
  41.  
  42. C Le IMODEL doit etre actif
  43. NOMID = IMODEL.LNOMID(1)
  44.  
  45. C S'ils sont déjà présents dans le IMODEL on ne se les refait pas...
  46. IF(NOMID .NE. 0 .AND. (MFR .EQ. MFR0))THEN
  47. NBROBL=LESOBL(/2)
  48. NBRFAC=LESFAC(/2)
  49. IPNOMC = NOMID
  50. RETURN
  51. ENDIF
  52.  
  53. C Sinon on les détermine
  54. MFR = MFR0
  55.  
  56. C Cas particuliers de la THERMIQUE, DIFFUSION, METALLURGIE
  57. NOM16=FORMOD(1)
  58. IF(NOM16 .EQ. 'THERMIQUE ') GOTO 1001
  59. IF(NOM16 .EQ. 'DIFFUSION ') GOTO 1002
  60. IF(NOM16 .EQ. 'METALLURGIE ') GOTO 1003
  61.  
  62. * formulation thermohydrique
  63. IF (MFR.EQ.65) THEN
  64. NBROBL=3
  65. SEGINI,NOMID
  66. LESOBL(1)='PG '
  67. LESOBL(2)='PC '
  68. LESOBL(3)='T '
  69. *
  70. * 0/ MACRO ELEMENT
  71. *
  72. ELSEIF (MFR.EQ.61)THEN
  73. C
  74. IF (IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
  75. *
  76. * 0-A/ CONTRAINTES PLANES - DEFORMATIONS PLANES
  77. *
  78. NBROBL=5
  79. SEGINI NOMID
  80. LESOBL(1)='UX '
  81. LESOBL(2)='UY '
  82. LESOBL(3)='RZ '
  83. LESOBL(4)='UM '
  84. LESOBL(5)='RM '
  85. ENDIF
  86.  
  87. C 1 - Elements COQUE (3), COQUE EPAISSE (5), POUTRE (7), COQUE en
  88. C CISAILLEMENT TRANSVERSE (9), TUYAU (13), LINESPRING (15), TUYAU
  89. C FISSURE (17), Barre excentree BAEX (49), LIA2 (51), JOI1(75)
  90. C ====================================================================
  91. ELSE IF (MFR.EQ. 3.OR.MFR.EQ. 5.OR.MFR.EQ. 7.OR.MFR.EQ. 9.OR.
  92. . MFR.EQ.13.OR.MFR.EQ.15.OR.MFR.EQ.17.OR.MFR.EQ.49.OR.
  93. . MFR.EQ.51.OR.MFR.EQ.75.OR.MFR.EQ.74) THEN
  94. C =====
  95. C 1.1 - Tridimensionnel
  96. C =====
  97. IF (IFOU.EQ.2) THEN
  98. NBROBL=6
  99. SEGINI,NOMID
  100. LESOBL(1)='UX '
  101. LESOBL(2)='UY '
  102. LESOBL(3)='UZ '
  103. LESOBL(4)='RX '
  104. LESOBL(5)='RY '
  105. LESOBL(6)='RZ '
  106. C =====
  107. C 1.2 - Fourier
  108. C =====
  109. ELSE IF (IFOU.EQ.1) THEN
  110. NBROBL=4
  111. SEGINI,NOMID
  112. LESOBL(1)='UR '
  113. LESOBL(2)='UZ '
  114. LESOBL(3)='UT '
  115. LESOBL(4)='RT '
  116. C =====
  117. C 1.3 - Axisymetrie
  118. C =====
  119. ELSE IF (IFOU.EQ.0) THEN
  120. NBROBL=3
  121. SEGINI,NOMID
  122. LESOBL(1)='UR '
  123. LESOBL(2)='UZ '
  124. LESOBL(3)='RT '
  125. C =====
  126. C 1.4 - Bidimensionnel PLAN (CP/DP)
  127. C =====
  128. ELSE IF (IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
  129. NBROBL=3
  130. SEGINI,NOMID
  131. LESOBL(1)='UX '
  132. LESOBL(2)='UY '
  133. LESOBL(3)='RZ '
  134. C =====
  135. C 1.5 - Bidimensionnel PLAN GENE
  136. C =====
  137. ELSE IF (IFOU.EQ.-3) THEN
  138. C Ici il faut distinguer les formulations :
  139. IF (MFR.EQ.03 .OR. MFR.EQ.05) THEN
  140. NBROBL=6
  141. SEGINI,NOMID
  142. LESOBL(1)='UX '
  143. LESOBL(2)='UY '
  144. LESOBL(3)='RZ '
  145. LESOBL(4)='UZ '
  146. LESOBL(5)='RY '
  147. LESOBL(6)='RX '
  148. ELSE
  149. NBROBL=3
  150. SEGINI,NOMID
  151. LESOBL(1)='UX '
  152. LESOBL(2)='UY '
  153. LESOBL(3)='RZ '
  154. ENDIF
  155. ENDIF
  156.  
  157. C 2 - Elements LIQUIDE
  158. C ======================
  159. ELSE IF (MFR.EQ.11) THEN
  160. NBROBL=2
  161. SEGINI,NOMID
  162. LESOBL(1)='P '
  163. LESOBL(2)='PI '
  164.  
  165. C 3 - Elements TUYAU ACOUSTIQUE PUR
  166. C ===================================
  167. ELSE IF (MFR.EQ.41) THEN
  168. NBROBL=2
  169. SEGINI,NOMID
  170. LESOBL(1)='PI '
  171. LESOBL(2)='P '
  172.  
  173. C 4 - Element de RACCORD LITU
  174. C =============================
  175. ELSE IF (MFR.EQ.43) THEN
  176. NBROBL=5
  177. SEGINI,NOMID
  178. LESOBL(1)='UX '
  179. LESOBL(2)='UY '
  180. LESOBL(3)='UZ '
  181. LESOBL(4)='PI '
  182. LESOBL(5)='P '
  183.  
  184. C 5 - Elements HOMOGENEISE
  185. C ==========================
  186. ELSE IF (MFR.EQ.37) THEN
  187. C =====
  188. C 5.1 - Fourier
  189. C =====
  190. IF (IFOU.EQ.1) THEN
  191. NBROBL=6
  192. SEGINI,NOMID
  193. LESOBL(1)='P '
  194. LESOBL(2)='PI '
  195. LESOBL(3)='UR '
  196. LESOBL(4)='RT '
  197. LESOBL(5)='UT '
  198. LESOBL(6)='RR '
  199. C =====
  200. C 5.2 - Axisymetrie
  201. C =====
  202. ELSE IF (IFOU.EQ.0) THEN
  203. NBROBL=4
  204. SEGINI,NOMID
  205. LESOBL(1)='P '
  206. LESOBL(2)='PI '
  207. LESOBL(3)='UR '
  208. LESOBL(4)='RT '
  209. C =====
  210. C 5.3 - Tridimensionnel
  211. C =====
  212. ELSE IF (IFOU.EQ.2) THEN
  213. NBROBL=6
  214. SEGINI,NOMID
  215. LESOBL(1)='P '
  216. LESOBL(2)='PI '
  217. LESOBL(3)='UX '
  218. LESOBL(4)='RY '
  219. LESOBL(5)='UY '
  220. LESOBL(6)='RX '
  221. C =====
  222. C 5.4 - Bidimensionnel PLAN (DP/CP/DPGE)
  223. C =====
  224. ELSE
  225. NBROBL=4
  226. SEGINI,NOMID
  227. LESOBL(1)='P '
  228. LESOBL(2)='PI '
  229. LESOBL(3)='UX '
  230. LESOBL(4)='UY '
  231. ENDIF
  232.  
  233. C 6 - Element de SURFACE LIBRE
  234. C ==============================
  235. ELSE IF (MFR.EQ.23) THEN
  236. NBROBL=3
  237. SEGINI,NOMID
  238. LESOBL(1)='P '
  239. LESOBL(2)='PI '
  240. LESOBL(3)='UZ '
  241.  
  242. C 7 - Element JOINT (35),JOINT CISAILLEMENT (53),JOINT GENERALISE (55)
  243. C COS2 (78)
  244. C =====================================================================
  245. ELSE IF (MFR.EQ.35.OR.MFR.EQ.53.OR.MFR.EQ.55.OR.MFR.EQ.78) THEN
  246. C =====
  247. C 7.1 - Tridimensionnel
  248. C =====
  249. IF (IFOU.EQ.2) THEN
  250. NBROBL=3
  251. SEGINI,NOMID
  252. LESOBL(1)='UX '
  253. LESOBL(2)='UY '
  254. LESOBL(3)='UZ '
  255. C =====
  256. C 7.2 - Bidimensionnel PLAN (CP/DP/DPGE)
  257. C =====
  258. ELSE IF (IFOU.EQ.-1.OR.IFOU.EQ.-2.OR.IFOU.EQ.-3) THEN
  259. NBROBL=2
  260. SEGINI,NOMID
  261. LESOBL(1)='UX '
  262. LESOBL(2)='UY '
  263. C =====
  264. C 7.3 - Axisymetrie
  265. C =====
  266. ELSE IF (IFOU.EQ.0) THEN
  267. NBROBL=2
  268. SEGINI,NOMID
  269. LESOBL(1)='UR '
  270. LESOBL(2)='UZ '
  271. ENDIF
  272.  
  273. C 8 - Elements MASSIFS, de MEMBRANE (25), UNIAXIALE (27),
  274. C NAVIER_STOKES(52)
  275. C ========================================================
  276. ELSE IF (MFR.EQ.1.OR.MFR.EQ.25.OR.MFR.EQ.27.OR.MFR.EQ.31.OR.
  277. $ MFR.EQ.72.OR.MFR.EQ.52) THEN
  278. C =====
  279. C 8.1 - Bidimensionnel PLAN (CP/DP)
  280. C =====
  281. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  282. NBROBL=2
  283. SEGINI,NOMID
  284. LESOBL(1)='UX '
  285. LESOBL(2)='UY '
  286.  
  287. C =====
  288. C 8.2 - Axisymetrie
  289. C =====
  290. ELSE IF (IFOU.EQ.0) THEN
  291. NBROBL=2
  292. SEGINI,NOMID
  293. LESOBL(1)='UR '
  294. LESOBL(2)='UZ '
  295. C =====
  296. C 8.3 - Fourier
  297. C =====
  298. ELSE IF (IFOU.EQ.1) THEN
  299. NBROBL=3
  300. SEGINI,NOMID
  301. LESOBL(1)='UR '
  302. LESOBL(2)='UZ '
  303. LESOBL(3)='UT '
  304. C =====
  305. C 8.4 - Tridimensionnel
  306. C =====
  307. ELSE IF (IFOU.EQ.2) THEN
  308. NBROBL=3
  309. SEGINI,NOMID
  310. LESOBL(1)='UX '
  311. LESOBL(2)='UY '
  312. LESOBL(3)='UZ '
  313. C =====
  314. C 8.5 - Bidimensionnel PLAN DPGE
  315. C =====
  316. ELSE IF (IFOU.EQ.-3) THEN
  317. NBROBL=5
  318. SEGINI,NOMID
  319. LESOBL(1)='UX '
  320. LESOBL(2)='UY '
  321. LESOBL(3)='UZ '
  322. LESOBL(4)='RY '
  323. LESOBL(5)='RX '
  324. C =====
  325. C 8.6 - Unidimensionnel (1D)
  326. C =====
  327. ELSE IF (IFOU.GE.3.AND.IFOU.LE.15.AND.MFR.EQ.1) THEN
  328. IF (IFOU.LE.6) THEN
  329. NBROBL=1
  330. SEGINI,NOMID
  331. LESOBL(1)='UX '
  332. ELSE IF (IFOU.EQ.7.OR.IFOU.EQ.8) THEN
  333. NBROBL=2
  334. SEGINI,NOMID
  335. LESOBL(1)='UX '
  336. LESOBL(2)='UY '
  337. ELSE IF (IFOU.EQ.9.OR.IFOU.EQ.10) THEN
  338. NBROBL=2
  339. SEGINI,NOMID
  340. LESOBL(1)='UX '
  341. LESOBL(2)='UZ '
  342. ELSE IF (IFOU.EQ.11) THEN
  343. NBROBL=3
  344. SEGINI,NOMID
  345. LESOBL(1)='UX '
  346. LESOBL(2)='UY '
  347. LESOBL(3)='UZ '
  348. ELSE IF (IFOU.EQ.12.OR.IFOU.EQ.13.OR.IFOU.EQ.15) THEN
  349. NBROBL=1
  350. SEGINI,NOMID
  351. LESOBL(1)='UR '
  352. ELSE IF (IFOU.EQ.14) THEN
  353. NBROBL=2
  354. SEGINI,NOMID
  355. LESOBL(1)='UR '
  356. LESOBL(2)='UZ '
  357. ENDIF
  358. ENDIF
  359.  
  360. C 10 - Formulation POREUX
  361. C =========================
  362. ELSE IF (MFR.EQ.33) THEN
  363. C ======
  364. C 10.1 - Bidimensionnel PLAN (CP/DP)
  365. C ======
  366. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  367. NBROBL=3
  368. SEGINI,NOMID
  369. LESOBL(1)='UX '
  370. LESOBL(2)='UY '
  371. LESOBL(3)='P '
  372. C ======
  373. C 10.2 - Axisymetrie
  374. C ======
  375. ELSE IF (IFOU.EQ.0) THEN
  376. NBROBL=3
  377. SEGINI,NOMID
  378. LESOBL(1)='UR '
  379. LESOBL(2)='UZ '
  380. LESOBL(3)='P '
  381. C ======
  382. C 10.3 - Fourier
  383. C ======
  384. ELSE IF (IFOU.EQ.1) THEN
  385. NBROBL=4
  386. SEGINI,NOMID
  387. LESOBL(1)='UR '
  388. LESOBL(2)='UZ '
  389. LESOBL(3)='UT '
  390. LESOBL(4)='P '
  391. C ======
  392. C 10.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
  393. C ======
  394. ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
  395. NBROBL=4
  396. SEGINI,NOMID
  397. LESOBL(1)='UX '
  398. LESOBL(2)='UY '
  399. LESOBL(3)='UZ '
  400. LESOBL(4)='P '
  401. ENDIF
  402.  
  403. C 11 - Formulation POREUX type Q
  404. C ================================
  405. ELSE IF (MFR.EQ.57) THEN
  406. C ======
  407. C 11.1 - Bidimensionnel PLAN (CP/DP)
  408. C ======
  409. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  410. NBROBL=4
  411. SEGINI,NOMID
  412. LESOBL(1)='UX '
  413. LESOBL(2)='UY '
  414. LESOBL(3)='P '
  415. LESOBL(4)='PQ '
  416. C ======
  417. C 11.2 - Axisymetrie
  418. C ======
  419. ELSE IF (IFOU.EQ.0) THEN
  420. NBROBL=4
  421. SEGINI,NOMID
  422. LESOBL(1)='UR '
  423. LESOBL(2)='UZ '
  424. LESOBL(3)='P '
  425. LESOBL(4)='PQ '
  426. C ======
  427. C 11.3 - Fourier
  428. C ======
  429. ELSE IF (IFOU.EQ.1) THEN
  430. NBROBL=5
  431. SEGINI,NOMID
  432. LESOBL(1)='UR '
  433. LESOBL(2)='UZ '
  434. LESOBL(3)='UT '
  435. LESOBL(4)='P '
  436. LESOBL(5)='PQ '
  437. C ======
  438. C 11.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
  439. C ======
  440. ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
  441. NBROBL=5
  442. SEGINI,NOMID
  443. LESOBL(1)='UX '
  444. LESOBL(2)='UY '
  445. LESOBL(3)='UZ '
  446. LESOBL(4)='P '
  447. LESOBL(5)='PQ '
  448. ENDIF
  449.  
  450. C 12 - Formulation POREUX type R
  451. C ================================
  452. ELSE IF (MFR.EQ.59) THEN
  453. C ======
  454. C 12.1 - Bidimensionnel PLAN (CP/DP)
  455. C ======
  456. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  457. NBROBL=5
  458. SEGINI,NOMID
  459. LESOBL(1)='UX '
  460. LESOBL(2)='UY '
  461. LESOBL(3)='P '
  462. LESOBL(4)='PQ '
  463. LESOBL(5)='TP '
  464. C ======
  465. C 12.2 - Axisymetrie
  466. C ======
  467. ELSE IF (IFOU.EQ.0) THEN
  468. NBROBL=5
  469. SEGINI,NOMID
  470. LESOBL(1)='UR '
  471. LESOBL(2)='UZ '
  472. LESOBL(3)='P '
  473. LESOBL(4)='PQ '
  474. LESOBL(5)='TP '
  475. C ======
  476. C 12.3 - Fourier
  477. C ======
  478. ELSE IF (IFOU.EQ.1) THEN
  479. NBROBL=6
  480. SEGINI,NOMID
  481. LESOBL(1)='UR '
  482. LESOBL(2)='UZ '
  483. LESOBL(3)='UT '
  484. LESOBL(4)='P '
  485. LESOBL(5)='PQ '
  486. LESOBL(6)='TP '
  487. C ======
  488. C 12.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
  489. C ======
  490. ELSE IF(IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
  491. NBROBL=6
  492. SEGINI,NOMID
  493. LESOBL(1)='UX '
  494. LESOBL(2)='UY '
  495. LESOBL(3)='UZ '
  496. LESOBL(4)='P '
  497. LESOBL(5)='PQ '
  498. LESOBL(6)='TP '
  499. ENDIF
  500.  
  501. C 13 - Elements de RACCORD
  502. C ==========================
  503. ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  504. NBROBL=2
  505. SEGINI,NOMID
  506. LESOBL(1)='P '
  507. LESOBL(2)='PI '
  508.  
  509. C 14 - Element de RACCORD MASSIF (2e serie de composantes)
  510. C ==========================================================
  511. ELSE IF (MFR.EQ.1019) THEN
  512. C ======
  513. C 14.1 - Bidimensionnel PLAN (CP/DP)
  514. C ======
  515. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  516. NBROBL=2
  517. SEGINI,NOMID
  518. LESOBL(1)='UX '
  519. LESOBL(2)='UY '
  520. C ======
  521. C 14.2 - Axisymetrie
  522. C ======
  523. ELSE IF (IFOU.EQ.0) THEN
  524. NBROBL=2
  525. SEGINI,NOMID
  526. LESOBL(1)='UR '
  527. LESOBL(2)='UZ '
  528. C ======
  529. C 14.3 - Fourier
  530. C ======
  531. ELSE IF (IFOU.EQ.1) THEN
  532. NBROBL=3
  533. SEGINI,NOMID
  534. LESOBL(1)='UR '
  535. LESOBL(2)='UZ '
  536. LESOBL(3)='UT '
  537. C ======
  538. C 14.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
  539. C ======
  540. ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
  541. NBROBL=3
  542. SEGINI,NOMID
  543. LESOBL(1)='UX '
  544. LESOBL(2)='UY '
  545. LESOBL(3)='UZ '
  546. ENDIF
  547.  
  548. C 15 - Element de RACCORD COQUE (2e serie de composantes)
  549. C =========================================================
  550. ELSE IF (MFR.EQ.1021) THEN
  551. C ======
  552. C 15.1 - Bidimensionnel PLAN (CP/DP)
  553. C ======
  554. IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  555. NBROBL=3
  556. SEGINI,NOMID
  557. LESOBL(1)='UX '
  558. LESOBL(2)='UY '
  559. LESOBL(3)='RZ '
  560. C ======
  561. C 15.2 - Axisymetrie
  562. C ======
  563. ELSE IF (IFOU.EQ.0) THEN
  564. NBROBL=3
  565. SEGINI,NOMID
  566. LESOBL(1)='UR '
  567. LESOBL(2)='UZ '
  568. LESOBL(3)='RT '
  569. C ======
  570. C 15.3 - Fourier
  571. C ======
  572. ELSE IF (IFOU.EQ.1) THEN
  573. NBROBL=4
  574. SEGINI,NOMID
  575. LESOBL(1)='UR '
  576. LESOBL(2)='UZ '
  577. LESOBL(3)='UT '
  578. LESOBL(4)='RT '
  579. C ======
  580. C 15.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
  581. C ======
  582. ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
  583. NBROBL=6
  584. SEGINI,NOMID
  585. LESOBL(1)='UX '
  586. LESOBL(2)='UY '
  587. LESOBL(3)='UZ '
  588. LESOBL(4)='RX '
  589. LESOBL(5)='RY '
  590. LESOBL(6)='RZ '
  591. ENDIF
  592.  
  593. C 16 - Element TUYO
  594. C ===================
  595. ELSE IF (MFR.EQ.39) THEN
  596. NBROBL=6+9
  597. SEGINI,NOMID
  598. LESOBL(1)='UX '
  599. LESOBL(2)='UY '
  600. LESOBL(3)='UZ '
  601. LESOBL(4)='RX '
  602. LESOBL(5)='RY '
  603. LESOBL(6)='RZ '
  604. LESOBL(7)='W0 '
  605. LESOBL(8)='U1 '
  606. LESOBL(9)='U2 '
  607. LESOBL(10)='U3 '
  608. LESOBL(11)='U4 '
  609. LESOBL(12)='W1 '
  610. LESOBL(13)='W2 '
  611. LESOBL(14)='W3 '
  612. LESOBL(15)='W4 '
  613. C 17 - Element POI1 materiau MODAL
  614. C ===================
  615. ELSE IF (MFR.EQ.26) THEN
  616. NBROBL=1
  617. SEGINI,NOMID
  618. LESOBL(1)='ALFA'
  619. C 18 - Element POI1 materiau STATIQUE
  620. C ===================
  621. ELSE IF (MFR.EQ.28) THEN
  622. NBROBL=1
  623. SEGINI,NOMID
  624. LESOBL(1)='BETA'
  625. C 19 - Element XFEM (xfem meca rupture)
  626. C ===================
  627. ELSEIF(MFR.EQ.63) THEN
  628. CTY - Element XQ4R (xfem meca rupture en 2D)
  629. IF(IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  630. NBROBL=2
  631. NBRFAC=18
  632. SEGINI,NOMID
  633. LESOBL(1)='UX '
  634. LESOBL(2)='UY '
  635. LESFAC(1)='AX '
  636. LESFAC(2)='AY '
  637. LESFAC(3)='B1X '
  638. LESFAC(4)='B1Y '
  639. LESFAC(5)='C1X '
  640. LESFAC(6)='C1Y '
  641. LESFAC(7)='D1X '
  642. LESFAC(8)='D1Y '
  643. LESFAC(9)='E1X '
  644. LESFAC(10)='E1Y '
  645. LESFAC(11)='B2X '
  646. LESFAC(12)='B2Y '
  647. LESFAC(13)='C2X '
  648. LESFAC(14)='C2Y '
  649. LESFAC(15)='D2X '
  650. LESFAC(16)='D2Y '
  651. LESFAC(17)='E2X '
  652. LESFAC(18)='E2Y '
  653. CTY - Element XC8R (xfem meca rupture en 3D)
  654. ELSE IF (IFOU.EQ.2) THEN
  655. NBROBL=3
  656. NBRFAC=27
  657. SEGINI,NOMID
  658. LESOBL(1)='UX '
  659. LESOBL(2)='UY '
  660. LESOBL(3)='UZ '
  661. LESFAC(1)='AX '
  662. LESFAC(2)='AY '
  663. LESFAC(3)='AZ '
  664. LESFAC(4)='B1X '
  665. LESFAC(5)='B1Y '
  666. LESFAC(6)='B1Z '
  667. LESFAC(7)='C1X '
  668. LESFAC(8)='C1Y '
  669. LESFAC(9)='C1Z '
  670. LESFAC(10)='D1X '
  671. LESFAC(11)='D1Y '
  672. LESFAC(12)='D1Z '
  673. LESFAC(13)='E1X '
  674. LESFAC(14)='E1Y '
  675. LESFAC(15)='E1Z '
  676. LESFAC(16)='B2X '
  677. LESFAC(17)='B2Y '
  678. LESFAC(18)='B2Z '
  679. LESFAC(19)='C2X '
  680. LESFAC(20)='C2Y '
  681. LESFAC(21)='C2Z '
  682. LESFAC(22)='D2X '
  683. LESFAC(23)='D2Y '
  684. LESFAC(24)='D2Z '
  685. LESFAC(25)='E2X '
  686. LESFAC(26)='E2Y '
  687. LESFAC(27)='E2Z '
  688. ENDIF
  689.  
  690. C 20 - Elements de zones cohesives
  691. C ==================================
  692. ELSEIF(MFR.EQ.77) THEN
  693. C - Element ZCO2 (xfem meca rupture en 2D)
  694. IF(IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
  695. NBROBL=2
  696. NBRFAC=18
  697. SEGINI,NOMID
  698. LESOBL(1)='AX '
  699. LESOBL(2)='AY '
  700. LESFAC(1)='UX '
  701. LESFAC(2)='UY '
  702. LESFAC(3)='B1X '
  703. LESFAC(4)='B1Y '
  704. LESFAC(5)='C1X '
  705. LESFAC(6)='C1Y '
  706. LESFAC(7)='D1X '
  707. LESFAC(8)='D1Y '
  708. LESFAC(9)='E1X '
  709. LESFAC(10)='E1Y '
  710. LESFAC(11)='B2X '
  711. LESFAC(12)='B2Y '
  712. LESFAC(13)='C2X '
  713. LESFAC(14)='C2Y '
  714. LESFAC(15)='D2X '
  715. LESFAC(16)='D2Y '
  716. LESFAC(17)='E2X '
  717. LESFAC(18)='E2Y '
  718. C - Elements ZCO3 et ZCO4(xfem meca rupture en 3D)
  719. ELSE IF (IFOU.EQ.2) THEN
  720. NBROBL=3
  721. NBRFAC=27
  722. SEGINI,NOMID
  723. LESOBL(1)='AX '
  724. LESOBL(2)='AY '
  725. LESOBL(3)='AZ '
  726. LESFAC(1)='UX '
  727. LESFAC(2)='UY '
  728. LESFAC(3)='UZ '
  729. LESFAC(4)='B1X '
  730. LESFAC(5)='B1Y '
  731. LESFAC(6)='B1Z '
  732. LESFAC(7)='C1X '
  733. LESFAC(8)='C1Y '
  734. LESFAC(9)='C1Z '
  735. LESFAC(10)='D1X '
  736. LESFAC(11)='D1Y '
  737. LESFAC(12)='D1Z '
  738. LESFAC(13)='E1X '
  739. LESFAC(14)='E1Y '
  740. LESFAC(15)='E1Z '
  741. LESFAC(16)='B2X '
  742. LESFAC(17)='B2Y '
  743. LESFAC(18)='B2Z '
  744. LESFAC(19)='C2X '
  745. LESFAC(20)='C2Y '
  746. LESFAC(21)='C2Z '
  747. LESFAC(22)='D2X '
  748. LESFAC(23)='D2Y '
  749. LESFAC(24)='D2Z '
  750. LESFAC(25)='E2X '
  751. LESFAC(26)='E2Y '
  752. LESFAC(27)='E2Z '
  753. ENDIF
  754.  
  755. C 21 - Formulation ELECTROSTATIQUE (base MASSIF)
  756. C ==================================
  757. ELSE IF (MFR.EQ.71) THEN
  758. NBROBL=1
  759. SEGINI,NOMID
  760. LESOBL(1)='VEL '
  761. ENDIF
  762.  
  763.  
  764. C Par DEFAUT : segment VIDE
  765. C ===========================
  766. IF (NOMID.EQ.0) THEN
  767. SEGINI,NOMID
  768. ELSE
  769. if (ifomod.eq.6) then
  770. nbrfa0 = nbrfac
  771. NBRFAC = NBROBL + (nbrfa0*2)
  772. segadj nomid
  773. do imo = 1,nbrobl
  774. lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  775. lesfac(nbrfa0 + imo)(1:1) = 'I'
  776. enddo
  777. do imo = 1,nbrfa0
  778. lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  779. lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  780. enddo
  781. endif
  782. ENDIF
  783.  
  784. IPNOMC=NOMID
  785. RETURN
  786.  
  787.  
  788.  
  789.  
  790. C 9 - Formulation THERMIQUE
  791. C ===========================
  792. 1001 CONTINUE
  793. C Cas des COQUES
  794. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  795. NPINT = 0
  796. if(infmod(/1).ne.0) NPINT=infmod(1)
  797. IF(NPINT.EQ.0) THEN
  798. NBROBL=3
  799. SEGINI NOMID
  800. LESOBL(1)='TINF '
  801. LESOBL(2)='T '
  802. LESOBL(3)='TSUP '
  803. ELSE
  804. NBROBL = 1
  805. SEGINI NOMID
  806. LESOBL(1)='T '
  807. ENDIF
  808. *
  809. *--- TOUS LES CAS SAUF COQUES ET COQUES EPAISSES
  810. *
  811. ELSE
  812. NBROBL=1
  813. SEGINI NOMID
  814. LESOBL(1)='T '
  815. ENDIF
  816. IPNOMC=NOMID
  817. RETURN
  818.  
  819. C 22 - Formulation DIFFUSION
  820. C ===========================
  821. 1002 CONTINUE
  822.  
  823. C Recuperation du LISTMOTS dans IVAMOD(1)
  824. MLMOT1=IVAMOD(1)
  825.  
  826. C Recuperation de l'inconnue PRIMALE
  827. CCOMP =MLMOT1.MOTS(1)
  828. NBCHAR=LONG(CCOMP)
  829.  
  830. C Cas des COQUES
  831. IF (MFR.EQ.3 .OR. MFR.EQ.5 .OR. MFR.EQ.9) THEN
  832. NPINT = 0
  833. if(infmod(/1).ne.0) NPINT=infmod(1)
  834. IF(NPINT.EQ.0) THEN
  835. NBROBL=3
  836. SEGINI NOMID
  837. IF(NBCHAR .GT. 4) THEN
  838. CALL ERREUR(536)
  839. RETURN
  840. ENDIF
  841.  
  842. LESOBL(1)=CCOMP(1:NBCHAR)//'IN '
  843. LESOBL(2)=CCOMP
  844. LESOBL(3)=CCOMP(1:NBCHAR)//'SU '
  845.  
  846. ELSE
  847. NBROBL = 1
  848. SEGINI NOMID
  849. LESOBL(1 )= CCOMP
  850. ENDIF
  851.  
  852. C Cas des autres elements
  853. ELSE
  854. NBROBL = 1
  855. SEGINI NOMID
  856. LESOBL(1)=CCOMP
  857. ENDIF
  858. IPNOMC=NOMID
  859. RETURN
  860.  
  861. C 23 - Formulation METALLURGIE
  862. C ==================================
  863. 1003 CONTINUE
  864. NBROBL=0
  865. NBRFAC=0
  866. SEGINI NOMID
  867. IPNOMC=NOMID
  868. RETURN
  869.  
  870. END
  871.  
  872.  
  873.  
  874.  
  875.  

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