Télécharger idmatr.eso

Retour à la liste

Numérotation des lignes :

idmatr
  1. C IDMATR SOURCE CB215821 21/03/03 21:15:16 10910
  2.  
  3. SUBROUTINE IDMATR(MFR,IPMODL,IPNOMC,NBROBL,NBRFAC)
  4.  
  5. *--------------------------------------------------------------------*
  6. * Noms de composantes de materiaux *
  7. *--------------------------------------------------------------------*
  8. * *
  9. * ENTREES: *
  10. * MFR Numero de formulation *
  11. * IPMODL objet modele elementaire ( segment actif ) *
  12. * *
  13. * SORTIES: *
  14. * IPNOMC pointeur sur les listes de noms de composantes *
  15. * obligatoires et facultatives *
  16. * NBROBL nombre de composantes obligatoires *
  17. * NBRFAC nombre de composantes facultatives *
  18. * *
  19. *--------------------------------------------------------------------*
  20. *
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMLMOTS
  28. POINTEUR MOOBL.MLMOTS
  29. -INC SMMODEL
  30. POINTEUR NOMID1.NOMID
  31. *
  32. LOGICAL lozut
  33. PARAMETER (ITA=100)
  34. CHARACTER*16 MOMODL(100)
  35. CHARACTER*(LOCOMP) TABOBL(ITA),TABFAC(ITA)
  36. *
  37. IMODEL=IPMODL
  38. * Le segment existe-t-il deja?
  39. IF (lnomid(6).NE.0) THEN
  40. nomid = lnomid(6)
  41. SEGACT,nomid
  42. nbrobl = lesobl(/2)
  43. nbrfac = lesfac(/2)
  44. IF (nbrobl+nbrfac.EQ.0) GOTO 765
  45. SEGINI,nomid1=nomid
  46. ipnomc=nomid1
  47. RETURN
  48. ENDIF
  49. 765 CONTINUE
  50.  
  51. JGOBL=0
  52. JGFAC=0
  53. ipnomc=0
  54. IRET = 1
  55. *
  56. NMAT=MATMOD(/2)
  57. NFOR=FORMOD(/2)
  58. MELE=NEFMOD
  59.  
  60. *--------------------------------------------------------------------
  61. * CAS DE LA FORMULATION THERMOHYDRIQUE
  62. *--------------------------------------------------------------------
  63. CALL PLACE(FORMOD,NFOR,ithehy,'THERMOHYDRIQUE')
  64. IF (ithehy.ne.0) then
  65. if ( matmod(1).eq.'SCHREFLER') then
  66. JGOBL = 20
  67. TABOBL(1)='KGG'
  68. TABOBL(2)='KGC'
  69. TABOBL(3)='KGT'
  70. TABOBL(4)='KCG'
  71. TABOBL(5)='KCC'
  72. TABOBL(6)='KCT'
  73. TABOBL(7)='KTG'
  74. TABOBL(8)='KTC'
  75. TABOBL(9)='KTT'
  76. TABOBL(10)='CGG'
  77. TABOBL(11)='CGC'
  78. TABOBL(12)='CGT'
  79. TABOBL(13)='CCG'
  80. TABOBL(14)='CCC'
  81. TABOBL(15)='CCT'
  82. TABOBL(16)='CTG'
  83. TABOBL(17)='CTC'
  84. TABOBL(18)='CTT'
  85. TABOBL(19)='KTGG'
  86. TABOBL(20)='KTCG'
  87. else
  88. IRET = 0
  89. call erreur(5)
  90. endif
  91. GO TO 9999
  92. ENDIF
  93.  
  94. *--------------------------------------------------------------------
  95. * CAS DE LA FORMULATION LIQUIDE ET ELEMENT DE RACCORD LITU
  96. *--------------------------------------------------------------------
  97. CALL PLACE(FORMOD,NFOR,ILIQU,'LIQUIDE')
  98. IF (ILIQU.NE.0) THEN
  99. IF (MFR.NE.41.AND.MFR.NE.43) THEN
  100. JGOBL = 6
  101. TABOBL(1)='RHO '
  102. TABOBL(2)='CSON'
  103. TABOBL(3)='RORF'
  104. TABOBL(4)='CREF'
  105. TABOBL(5)='LCAR'
  106. TABOBL(6)='G '
  107.  
  108. ELSEIF (MFR.EQ.41) THEN
  109. JGOBL = 5
  110. TABOBL(1)='RHO '
  111. TABOBL(2)='CSON'
  112. TABOBL(3)='RORF'
  113. TABOBL(4)='CREF'
  114. TABOBL(5)='LCAR'
  115. c* ELSEIF (MFR.EQ.43) THEN
  116. ELSE
  117. JGOBL = 3
  118. TABOBL(1)='RHO '
  119. TABOBL(2)='LCAR'
  120. TABOBL(3)='RORF'
  121. ENDIF
  122. GOTO 9999
  123. ENDIF
  124.  
  125. *--------------------------------------------------------------------
  126. * CAS DE LA FORMULATION THERMIQUE
  127. * CAS DE LA FORMULATION DARCY
  128. *--------------------------------------------------------------------
  129. CALL PLACE(FORMOD,NFOR,ITHER ,'THERMIQUE')
  130. CALL PLACE(FORMOD,NFOR,IDARCY,'DARCY' )
  131. IF (ITHER.NE.0 .OR. IDARCY.NE.0) THEN
  132.  
  133. IF (ITHER.NE.0) THEN
  134.  
  135. C Cas particuliers de THERMIQUE CONVECTION :
  136. CALL PLACE(MATMOD,NMAT,ICONV,'CONVECTION')
  137. IF (ICONV.NE.0) THEN
  138. C IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  139. CC Coques thermiques
  140. C JGOBL =2
  141. C TABOBL(1)='HINF'
  142. C TABOBL(2)='HSUP'
  143. C JGFAC =2
  144. C TABFAC(1)='TCINF'
  145. C TABFAC(2)='TCSUP'
  146. C else
  147. C Elements massifs
  148. JGOBL = 1
  149. TABOBL(1)='H'
  150. JGFAC=1
  151. TABFAC(1)='TC'
  152. C endif
  153. GOTO 9999
  154. ENDIF
  155.  
  156. C Cas particuliers de THERMIQUE RAYONNEMENT :
  157. CALL PLACE(MATMOD,NMAT,IRAYE,'RAYONNEMENT')
  158. IF (IRAYE.NE.0) THEN
  159. C Cas particuliers de THERMIQUE RAYONNEMENT :
  160. CALL PLACE(MATMOD,NMAT,ICAVE,'CAVITE')
  161. CALL PLACE(MATMOD,NMAT,IFACA,'FAC_A_FAC')
  162. CALL PLACE(MATMOD,NMAT,IINFI,'INFINI')
  163.  
  164. IF (ICAVE.NE.0) THEN
  165. C RAYONNEMENT en CAVITE :
  166. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  167. JGOBL=2
  168. TABOBL(1)='EINF'
  169. TABOBL(2)='ESUP'
  170. else
  171. JGOBL=1
  172. TABOBL(1)='EMIS'
  173. endif
  174.  
  175. JGFAC=3
  176. TABFAC(1)='CABS'
  177. TABFAC(2)='TABS'
  178. TABFAC(3)='H'
  179.  
  180. ELSE IF (IFACA.NE.0) THEN
  181. C RAYONNEMENT FACE_A_FACE :
  182. JGOBL=1
  183. TABOBL(1)='EMIS'
  184. JGFAC = 1
  185. TABFAC(1)='H'
  186.  
  187. ELSE IF (IINFI.NE.0) THEN
  188. C RAYONNEMENT a l'INFINI :
  189. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  190. JGOBL=3
  191. TABOBL(1)='EINF'
  192. TABOBL(2)='ESUP'
  193. TABOBL(3)='T_IN'
  194. ELSE
  195. JGOBL=2
  196. TABOBL(1)='EMIS'
  197. TABOBL(2)='T_IN'
  198. ENDIF
  199.  
  200. JGFAC = 2
  201. TABFAC(1)='E_IN'
  202. TABFAC(2)='H'
  203.  
  204. ELSE
  205. IRET = 0
  206. CALL ERREUR(5)
  207. ENDIF
  208. GOTO 9999
  209. ENDIF
  210.  
  211. C Cas particuliers de THERMIQUE SOURCE :
  212. ISRCE = 0
  213. CALL PLACE(MATMOD,NMAT,ISRCE,'SOURCE')
  214. IF (ISRCE.NE.0) THEN
  215. IF (INATUU.EQ.1.AND.IMATEE.EQ.1) THEN
  216. JGOBL = 1
  217. TABOBL(1)='QVOL'
  218. JGFAC = 2
  219. TABFAC(1)='QINF'
  220. TABFAC(2)='QSUP'
  221. GOTO 9999
  222. ELSEIF (INATUU.EQ.2.AND.IMATEE.EQ.1) THEN
  223. JGOBL = 3
  224. TABOBL(1)='QTOT'
  225. TABOBL(2)='ORIG'
  226. TABOBL(3)='RGAU'
  227. GOTO 9999
  228. ELSEIF (INATUU.EQ.2.AND.IMATEE.EQ.2) THEN
  229. JGOBL = 5
  230. TABOBL(1)='QTOT'
  231. TABOBL(2)='ORIG'
  232. TABOBL(3)='RGAU'
  233. TABOBL(4)='DIRE'
  234. TABOBL(5)='ZGAU'
  235. GOTO 9999
  236. ELSE
  237. c write(6,*) 'INATUU, IMATEE =',INATUU, IMATEE
  238. WRITE(6,*) ' Dans IDMATR : numero IMATEE non prevu'
  239. CALL ERREUR(21)
  240. RETURN
  241. ENDIF
  242. ENDIF
  243.  
  244. ENDIF
  245.  
  246. C* Cas THERMIQUE et DARCY
  247. CALL PLACE(MATMOD,NMAT,IORTH,'ORTHOTROPE')
  248. CALL PLACE(MATMOD,NMAT,IANIS,'ANISOTROPE')
  249. IF (IORTH.EQ.0.AND.IANIS.EQ.0)THEN
  250. JGOBL = 1
  251. IF(MFR .EQ. 75)THEN
  252. C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES
  253. C ====================
  254. TABOBL(1)='KT'
  255. ELSE
  256. TABOBL(1)='K '
  257. ENDIF
  258.  
  259. ELSE IF (IORTH.NE.0) THEN
  260. * ELEMENTS COQUES
  261. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  262. JGOBL=5
  263. TABOBL(1)='K1 '
  264. TABOBL(2)='K2 '
  265. TABOBL(3)='K3 '
  266. TABOBL(4)='V1X '
  267. TABOBL(5)='V1Y '
  268.  
  269. ELSE IF (MFR.EQ.1.OR.MFR.EQ.45) THEN
  270. * ELEMENTS MASSIFS et HYBRIDES
  271. IF (IDIM.EQ.2) THEN
  272. IF (IFOMOD.EQ.1) THEN
  273. * ELEMENT MASSIF DE FOURIER
  274. JGOBL=5
  275. TABOBL(1)='K1 '
  276. TABOBL(2)='K2 '
  277. TABOBL(3)='V1X '
  278. TABOBL(4)='V1Y '
  279. TABOBL(5)='K3 '
  280.  
  281. ELSE
  282. JGOBL=4
  283. TABOBL(1)='K1 '
  284. TABOBL(2)='K2 '
  285. TABOBL(3)='V1X '
  286. TABOBL(4)='V1Y '
  287. ENDIF
  288.  
  289. ELSEIF (IDIM.EQ.3) THEN
  290. JGOBL=9
  291. TABOBL(1)='K1 '
  292. TABOBL(2)='K2 '
  293. TABOBL(3)='K3 '
  294. TABOBL(4)='V1X '
  295. TABOBL(5)='V1Y '
  296. TABOBL(6)='V1Z '
  297. TABOBL(7)='V2X '
  298. TABOBL(8)='V2Y '
  299. TABOBL(9)='V2Z '
  300. ENDIF
  301. ENDIF
  302.  
  303. ELSEIF (IANIS.NE.0) THEN
  304. * ELEMENTS MASSIFS
  305. IF (MFR.EQ.1.OR.MFR.EQ.45) THEN
  306. IF (IDIM.EQ.2) THEN
  307. IF (IFOMOD.EQ.1) THEN
  308. * ELEMENT MASSIF DE FOURIER
  309. JGOBL=6
  310. TABOBL(1)='K11 '
  311. TABOBL(2)='K22 '
  312. TABOBL(3)='K21 '
  313. TABOBL(4)='V1X '
  314. TABOBL(5)='V1Y '
  315. TABOBL(6)='K33 '
  316.  
  317. ELSE
  318. JGOBL=5
  319. TABOBL(1)='K11 '
  320. TABOBL(2)='K22 '
  321. TABOBL(3)='K21 '
  322. TABOBL(4)='V1X '
  323. TABOBL(5)='V1Y '
  324. ENDIF
  325.  
  326. ELSEIF (IDIM.EQ.3) THEN
  327. JGOBL=12
  328. TABOBL(1)='K11 '
  329. TABOBL(2)='K22 '
  330. TABOBL(3)='K33 '
  331. TABOBL(4)='K21 '
  332. TABOBL(5)='K31 '
  333. TABOBL(6)='K32 '
  334. TABOBL(7)='V1X '
  335. TABOBL(8)='V1Y '
  336. TABOBL(9)='V1Z '
  337. TABOBL(10)='V2X '
  338. TABOBL(11)='V2Y '
  339. TABOBL(12)='V2Z '
  340. ENDIF
  341. ENDIF
  342. ENDIF
  343. C*
  344. C* Cas THERMIQUE CONDUCTION, THERMIQUE PHASE ou THERMIQUE ADVECTION :
  345. IF (ITHER.NE.0) THEN
  346.  
  347. CALL PLACE(MATMOD,NMAT,IPHA,'PHASE')
  348. IF (IPHA.NE.0) THEN
  349. JGM0 = JGOBL
  350. JGOBL= JGM0+4
  351. TABOBL(JGM0+1)='RHO '
  352. TABOBL(JGM0+2)='C '
  353. TABOBL(JGM0+3)='QLAT'
  354. TABOBL(JGM0+4)='TPHA'
  355.  
  356. JGFAC=1
  357. TABFAC(1)='H '
  358. GOTO 9999
  359. ENDIF
  360.  
  361. CALL PLACE(MATMOD,NMAT,IADVE,'ADVECTION')
  362. if (iadve .ne. 0) then
  363. C Cas des Tuyaux 1D (MFR=79)
  364. C ===========================
  365. IF (MFR .EQ. 79) THEN
  366. JGFAC = 3
  367. TABFAC(1)='RHO '
  368. TABFAC(2)='C '
  369. TABFAC(3)='VITE'
  370.  
  371. C Cas Massif (MFR=1)
  372. C ===========================
  373. ELSEIF (MFR .EQ. 1) THEN
  374. C Bidimensionnel PLAN DPGE
  375. C ===========================
  376. IF (IFOUR.EQ.-3) THEN
  377. JGFAC = 5
  378. TABFAC(1)='RHO '
  379. TABFAC(2)='C '
  380. TABFAC(3)='UX '
  381. TABFAC(4)='UY '
  382. TABFAC(5)='UZ '
  383.  
  384. C Bidimensionnel PLAN (CP/DP)
  385. C ===========================
  386. ELSE IF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN
  387. JGFAC = 4
  388. TABFAC(1)='RHO '
  389. TABFAC(2)='C '
  390. TABFAC(3)='UX '
  391. TABFAC(4)='UY '
  392.  
  393. C Axisymetrie
  394. C ===========================
  395. ELSE IF (IFOUR .EQ. 0) THEN
  396. JGFAC = 4
  397. TABFAC(1)='RHO '
  398. TABFAC(2)='C '
  399. TABFAC(3)='UR '
  400. TABFAC(4)='UZ '
  401.  
  402. C Fourier
  403. C ===========================
  404. ELSE IF (IFOUR .EQ. 1) THEN
  405. CALL ERREUR(21)
  406. RETURN
  407. C JGFAC = 5C
  408. C TABFAC(1)='RHO '
  409. C TABFAC(2)='C '
  410. C TABFAC(3)='UR '
  411. C TABFAC(4)='UZ '
  412. C TABFAC(5)='UT '
  413.  
  414. C Tridimensionnel
  415. C ===========================
  416. ELSE IF (IFOUR .EQ. 2) THEN
  417. JGFAC = 5
  418. TABFAC(1)='RHO '
  419. TABFAC(2)='C '
  420. TABFAC(3)='UX '
  421. TABFAC(4)='UY '
  422. TABFAC(5)='UZ '
  423.  
  424. C Unidimensionnel (1D)
  425. C ===========================
  426. ELSE IF (IFOUR.GE.3 .AND. IFOUR.LE.15) THEN
  427. IF (IFOUR.LE.6) THEN
  428. JGFAC = 3
  429. TABFAC(1)='RHO '
  430. TABFAC(2)='C '
  431. TABFAC(3)='UX '
  432.  
  433. ELSE IF (IFOUR.EQ.7 .OR. IFOUR.EQ.8) THEN
  434. JGFAC = 4
  435. C Verifier l'utilite des compsantes au dela de 4
  436. TABFAC(1)='RHO '
  437. TABFAC(2)='C '
  438. TABFAC(3)='UX '
  439. TABFAC(4)='UY '
  440.  
  441. ELSE IF (IFOUR.EQ.9 .OR. IFOUR.EQ.10) THEN
  442. JGFAC = 4
  443. C Verifier l'utilite des compsantes au dela de 4
  444. TABFAC(1)='RHO '
  445. TABFAC(2)='C '
  446. TABFAC(3)='UX '
  447. TABFAC(4)='UZ '
  448.  
  449. ELSE IF (IFOUR.EQ.11) THEN
  450. JGFAC = 5
  451. C Verifier l'utilite des compsantes au dela de 4
  452. TABFAC(1)='RHO '
  453. TABFAC(2)='C '
  454. TABFAC(3)='UX '
  455. TABFAC(4)='UY '
  456. TABFAC(5)='UZ '
  457.  
  458. ELSE IF (IFOUR.EQ.12.OR.IFOUR.EQ.13.OR.IFOUR.EQ.15) THEN
  459. JGFAC = 3
  460. TABFAC(1)='RHO '
  461. TABFAC(2)='C '
  462. TABFAC(3)='UR '
  463.  
  464. ELSE IF (IFOUR.EQ.14) THEN
  465. JGFAC = 4
  466. C Verifier l'utilite des compsantes au dela de 4
  467. TABFAC(1)='RHO '
  468. TABFAC(2)='C '
  469. TABFAC(3)='UR '
  470. TABFAC(4)='UZ '
  471. ENDIF
  472. ENDIF
  473. ENDIF
  474. GOTO 9999
  475. endif
  476.  
  477. C composantes facultatives THERMIQUE CONDUCTION seule
  478. IF(MFR .EQ. 75)THEN
  479. C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES
  480. C ====================
  481. JGFAC = 4
  482. TABFAC(1)='M'
  483. TABFAC(2)='C'
  484. TABFAC(3)='TINI'
  485. ELSE
  486. JGFAC = 4
  487. TABFAC(1)='RHO '
  488. TABFAC(2)='C '
  489. TABFAC(3)='H '
  490. TABFAC(4)='TINI'
  491. ENDIF
  492. ENDIF
  493. GOTO 9999
  494. ENDIF
  495.  
  496. *--------------------------------------------------------------------
  497. * CAS DE LA FORMULATION MECANIQUE
  498. *--------------------------------------------------------------------
  499. CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE')
  500. IF (IMECA.NE.0) THEN
  501. *
  502. CALL MODLIN(MOMODL,NMOD)
  503. CALL PLACE(MOMODL,NMOD,IRET,MATMOD(1))
  504. IF (IRET.EQ.0) GOTO 9999
  505. IF (NMAT.GE.2) THEN
  506.  
  507. CALL MODELA(MOMODL,NMOD)
  508. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(2))
  509. if ((IPLAC.EQ.9.OR.IPLAC.EQ.10).AND.NMAT.GT.2) then
  510. INMAT = 3
  511. goto 19
  512. endif
  513.  
  514. IF (IPLAC.NE.0) THEN
  515. INMAT=3
  516. IF (IPLAC.EQ.1) THEN
  517. INMAT=3
  518. GOTO 10
  519. ENDIF
  520. IF (IPLAC.EQ.2) THEN
  521. *
  522. * MATERIAU ELASTIQUE ORTHOTROPE
  523. *
  524. IF (MFR.EQ.75) THEN
  525. * JOINT UNIDIMENSIONNEL JOI1
  526. *
  527. IF(IFOUR.EQ.2)THEN
  528. JGOBL=12
  529. TABOBL(1)='V1X '
  530. TABOBL(2)='V1Y '
  531. TABOBL(3)='V1Z '
  532. TABOBL(4)='V2X '
  533. TABOBL(5)='V2Y '
  534. TABOBL(6)='V2Z '
  535. TABOBL(7)='KN '
  536. TABOBL(8)='KS1 '
  537. TABOBL(9)='KS2 '
  538. TABOBL(10)='QN '
  539. TABOBL(11)='QS1 '
  540. TABOBL(12)='QS2 '
  541. *
  542. JGFAC=10
  543. TABFAC(1)='MASS'
  544. TABFAC(2)='JX '
  545. TABFAC(3)='JY '
  546. TABFAC(4)='JZ '
  547. TABFAC(5)='ALPN'
  548. TABFAC(6)='ALP1'
  549. TABFAC(7)='ALP2'
  550. TABFAC(8)='ALQN'
  551. TABFAC(9)='ALQ1'
  552. TABFAC(10)='ALQ2'
  553. *
  554. ELSEIF(IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  555. JGOBL=5
  556. TABOBL(1)='V1X '
  557. TABOBL(2)='V1Y '
  558. TABOBL(3)='KN '
  559. TABOBL(4)='KS '
  560. TABOBL(5)='QS '
  561. *
  562. JGFAC=6
  563. TABFAC(1)='MASS'
  564. TABFAC(2)='JZ'
  565. TABFAC(4)='ALPN'
  566. TABFAC(5)='ALPS'
  567. TABFAC(6)='ALQS'
  568. ENDIF
  569. *
  570. ELSEIF (MFR.EQ.3) THEN
  571. * COQUES MINCES
  572. *
  573. JGOBL=6
  574. TABOBL(1)='YG1 '
  575. TABOBL(2)='YG2 '
  576. TABOBL(3)='NU12'
  577. TABOBL(4)='G12 '
  578. TABOBL(5)='V1X '
  579. TABOBL(6)='V1Y '
  580. *
  581. IF(IFOUR.EQ.-2) THEN
  582. JGFAC=4
  583. ELSE
  584. JGFAC=3
  585. ENDIF
  586. TABFAC(1)='ALP1'
  587. TABFAC(2)='ALP2'
  588. TABFAC(3)='RHO '
  589. IF(IFOUR.EQ.-2) TABFAC(4)='DIM3'
  590.  
  591. ELSEIF (MFR.EQ.9.OR.MFR.EQ.5) THEN
  592. * COQUES AVEC CISAILLEMENT TRANSVERSE
  593. *
  594. JGOBL=8
  595. TABOBL(1)='YG1 '
  596. TABOBL(2)='YG2 '
  597. TABOBL(3)='NU12'
  598. TABOBL(4)='G12 '
  599. TABOBL(5)='G23 '
  600. TABOBL(6)='G13 '
  601. TABOBL(7)='V1X '
  602. TABOBL(8)='V1Y '
  603. *
  604. JGFAC=3
  605. TABFAC(1)='RHO '
  606. TABFAC(2)='ALP1'
  607. TABFAC(3)='ALP2'
  608.  
  609. ELSEIF (MFR.EQ.1.OR.MFR.EQ.31) THEN
  610. * ELEMENTS MASSIFS
  611. *
  612. IF(IDIM.EQ.3)THEN
  613. * ELEMENTS 3D
  614. JGOBL=15
  615. TABOBL(1)='YG1 '
  616. TABOBL(2)='YG2 '
  617. TABOBL(3)='YG3 '
  618. TABOBL(4)='NU12'
  619. TABOBL(5)='NU23'
  620. TABOBL(6)='NU13'
  621. TABOBL(7)='G12 '
  622. TABOBL(8)='G23 '
  623. TABOBL(9)='G13 '
  624. TABOBL(10)='V1X '
  625. TABOBL(11)='V1Y '
  626. TABOBL(12)='V1Z '
  627. TABOBL(13)='V2X '
  628. TABOBL(14)='V2Y '
  629. TABOBL(15)='V2Z '
  630. *
  631. JGFAC=4
  632. TABFAC(1)='RHO '
  633. TABFAC(2)='ALP1'
  634. TABFAC(3)='ALP2'
  635. TABFAC(4)='ALP3'
  636.  
  637. ELSEIF (IDIM.EQ.2) THEN
  638. IF(IFOUR.EQ.-2)THEN
  639. * CONTRAINTE PLANE
  640. JGOBL=9
  641. TABOBL(1)='YG1 '
  642. TABOBL(2)='YG2 '
  643. TABOBL(3)='NU12'
  644. TABOBL(4)='G12 '
  645. TABOBL(5)='V1X '
  646. TABOBL(6)='V1Y '
  647. TABOBL(7)='YG3 '
  648. TABOBL(8)='NU23'
  649. TABOBL(9)='NU13'
  650. *
  651. JGFAC=4
  652. TABFAC(1)='RHO '
  653. TABFAC(2)='ALP1'
  654. TABFAC(3)='ALP2'
  655. TABFAC(4)='DIM3'
  656.  
  657. ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  658. * DEFORMATION PLANE ,AXISYMETRIE
  659. JGOBL=9
  660. TABOBL(1)='YG1 '
  661. TABOBL(2)='YG2 '
  662. TABOBL(3)='YG3 '
  663. TABOBL(4)='NU12'
  664. TABOBL(5)='NU23'
  665. TABOBL(6)='NU13'
  666. TABOBL(7)='G12 '
  667. TABOBL(8)='V1X '
  668. TABOBL(9)='V1Y '
  669. *
  670. JGFAC=4
  671. TABFAC(1)='RHO '
  672. TABFAC(2)='ALP1'
  673. TABFAC(3)='ALP2'
  674. TABFAC(4)='ALP3'
  675.  
  676. ELSEIF (IFOUR.EQ.1) THEN
  677. * AXISYMETRIE DE FOURIER
  678. JGOBL=15
  679. TABOBL(1)='YG1 '
  680. TABOBL(2)='YG2 '
  681. TABOBL(3)='YG3 '
  682. TABOBL(4)='NU12'
  683. TABOBL(5)='NU23'
  684. TABOBL(6)='NU13'
  685. TABOBL(7)='G12 '
  686. TABOBL(8)='G23 '
  687. TABOBL(9)='G13 '
  688. TABOBL(10)='V1X '
  689. TABOBL(11)='V1Y '
  690. TABOBL(12)='V1Z '
  691. TABOBL(13)='V2X '
  692. TABOBL(14)='V2Y '
  693. TABOBL(15)='V2Z '
  694. *
  695. JGFAC=4
  696. TABFAC(1)='RHO '
  697. TABFAC(2)='ALP1'
  698. TABFAC(3)='ALP2'
  699. TABFAC(4)='ALP3'
  700. ENDIF
  701. ELSEIF (IDIM.EQ.1) THEN
  702. C= Dans le cas UNID SPHErique, on doit avoir YG2=YG3 et NU12=NU13
  703. C= et dans le cas thermomecanique ALP2=ALP3.
  704. JGOBL=6
  705. TABOBL(1)='YG1 '
  706. TABOBL(2)='YG2 '
  707. TABOBL(3)='YG3 '
  708. TABOBL(4)='NU12'
  709. TABOBL(5)='NU23'
  710. TABOBL(6)='NU13'
  711.  
  712. IF (IFOUR.EQ.6) THEN
  713. JGFAC=2
  714.  
  715. ELSEIF (IFOUR.EQ.5 .OR. IFOUR.EQ.10) THEN
  716. JGFAC=3
  717. TABFAC(3)='ALP3'
  718. ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.
  719. . IFOUR.EQ.13) THEN
  720. JGFAC=3
  721. TABFAC(3)='ALP2'
  722. ELSE
  723. JGFAC=4
  724. TABFAC(3)='ALP2'
  725. TABFAC(4)='ALP3'
  726. ENDIF
  727. TABFAC(1)='RHO '
  728. TABFAC(2)='ALP1'
  729. ENDIF
  730.  
  731. ELSEIF (MFR.EQ.35) THEN
  732. * ELEMENTS JOINTS
  733. IF (IFOUR.EQ.2) THEN
  734. JGOBL=5
  735. TABOBL(1)='KS1 '
  736. TABOBL(2)='KS2 '
  737. TABOBL(3)='KN '
  738. TABOBL(4)='V1X '
  739. TABOBL(5)='V1Y '
  740. *
  741. JGFAC=2
  742. TABFAC(1)='RHO '
  743. TABFAC(2)='ALPN'
  744. ENDIF
  745. ENDIF
  746.  
  747. ELSEIF (IPLAC.EQ.3)THEN
  748. * MATERIAU ANISOTROPE ELASTIQUE
  749. *
  750. IF(MFR.EQ.75)THEN
  751. * JOINT UNIDIMESIONNEL JOI1
  752. *
  753. IF (IFOUR.EQ.2) THEN
  754. JGOBL=27
  755. TABOBL(1)='V1X '
  756. TABOBL(2)='V1Y '
  757. TABOBL(3)='V1Z '
  758. TABOBL(4)='V2X '
  759. TABOBL(5)='V2Y '
  760. TABOBL(6)='V2Z '
  761. TABOBL(7)='D11 '
  762. TABOBL(8)='D22 '
  763. TABOBL(9)='D33 '
  764. TABOBL(10)='D44 '
  765. TABOBL(11)='D55 '
  766. TABOBL(12)='D66 '
  767. TABOBL(13)='D21 '
  768. TABOBL(14)='D31 '
  769. TABOBL(15)='D32 '
  770. TABOBL(16)='D41 '
  771. TABOBL(17)='D42 '
  772. TABOBL(18)='D43 '
  773. TABOBL(19)='D51 '
  774. TABOBL(20)='D52 '
  775. TABOBL(21)='D53 '
  776. TABOBL(22)='D54 '
  777. TABOBL(23)='D61 '
  778. TABOBL(24)='D62 '
  779. TABOBL(25)='D63 '
  780. TABOBL(26)='D64 '
  781. TABOBL(27)='D65 '
  782. *
  783. JGFAC=10
  784. * MASS: masse totale de l'élément joint
  785. TABFAC(1)='MASS'
  786. TABFAC(2)='JX '
  787. TABFAC(3)='JY '
  788. TABFAC(4)='JZ '
  789. TABFAC(5)='ALP1'
  790. TABFAC(6)='ALP2'
  791. TABFAC(7)='ALP3'
  792. TABFAC(8)='ALQ1'
  793. TABFAC(9)='ALQ2'
  794. TABFAC(10)='ALQ3'
  795. *
  796. ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  797. JGOBL=8
  798. TABOBL(1)='V1X '
  799. TABOBL(2)='V1Y '
  800. TABOBL(3)='D11 '
  801. TABOBL(4)='D22 '
  802. TABOBL(5)='D33 '
  803. TABOBL(6)='D21 '
  804. TABOBL(7)='D31 '
  805. TABOBL(8)='D32 '
  806. *
  807. JGFAC=5
  808. * MASS: masse totale de l'élément joint
  809. TABFAC(1)='MASS'
  810. TABFAC(2)='JZ '
  811. TABFAC(3)='ALP1'
  812. TABFAC(4)='ALP2'
  813. TABFAC(5)='ALQ3'
  814. ENDIF
  815. ENDIF
  816. *
  817. * ELEMENTS MASSIFS
  818. *
  819. IF(MFR.EQ.1.OR.MFR.EQ.31)THEN
  820. IF(IDIM.EQ.3)THEN
  821. * ELEMENTS 3D
  822. JGOBL=27
  823. TABOBL(1)='D11 '
  824. TABOBL(2)='D21 '
  825. TABOBL(3)='D22 '
  826. TABOBL(4)='D31 '
  827. TABOBL(5)='D32 '
  828. TABOBL(6)='D33 '
  829. TABOBL(7)='D41 '
  830. TABOBL(8)='D42 '
  831. TABOBL(9)='D43 '
  832. TABOBL(10)='D44 '
  833. TABOBL(11)='D51 '
  834. TABOBL(12)='D52 '
  835. TABOBL(13)='D53 '
  836. TABOBL(14)='D54 '
  837. TABOBL(15)='D55 '
  838. TABOBL(16)='D61 '
  839. TABOBL(17)='D62 '
  840. TABOBL(18)='D63 '
  841. TABOBL(19)='D64 '
  842. TABOBL(20)='D65 '
  843. TABOBL(21)='D66 '
  844. TABOBL(22)='V1X '
  845. TABOBL(23)='V1Y '
  846. TABOBL(24)='V1Z '
  847. TABOBL(25)='V2X '
  848. TABOBL(26)='V2Y '
  849. TABOBL(27)='V2Z '
  850. *
  851. JGFAC=7
  852. TABFAC(1)='RHO '
  853. TABFAC(2)='ALP1'
  854. TABFAC(3)='ALP2'
  855. TABFAC(4)='ALP3'
  856. TABFAC(5)='AL12'
  857. TABFAC(6)='AL13'
  858. TABFAC(7)='AL23'
  859.  
  860. ELSEIF (IDIM.EQ.2) THEN
  861. IF (IFOUR.EQ.-2) THEN
  862. * CONTRAINTE PLANE
  863. JGOBL=12
  864. TABOBL(1)='D11 '
  865. TABOBL(2)='D21 '
  866. TABOBL(3)='D22 '
  867. TABOBL(4)='D41 '
  868. TABOBL(5)='D42 '
  869. TABOBL(6)='D44 '
  870. TABOBL(7)='V1X '
  871. TABOBL(8)='V1Y '
  872. TABOBL(9)='D31 '
  873. TABOBL(10)='D32 '
  874. TABOBL(11)='D33 '
  875. TABOBL(12)='D43 '
  876. *
  877. JGFAC=5
  878. TABFAC(1)='RHO '
  879. TABFAC(2)='ALP1'
  880. TABFAC(3)='ALP2'
  881. TABFAC(4)='AL12'
  882. TABFAC(5)='DIM3'
  883.  
  884. ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  885. * DEFORMATION PLANE ,AXISYMETRIE
  886. JGOBL=12
  887. TABOBL(1)='D11 '
  888. TABOBL(2)='D21 '
  889. TABOBL(3)='D22 '
  890. TABOBL(4)='D31 '
  891. TABOBL(5)='D32 '
  892. TABOBL(6)='D33 '
  893. TABOBL(7)='D41 '
  894. TABOBL(8)='D42 '
  895. TABOBL(9)='D43 '
  896. TABOBL(10)='D44 '
  897. TABOBL(11)='V1X '
  898. TABOBL(12)='V1Y '
  899. *
  900. JGFAC=5
  901. TABFAC(1)='RHO '
  902. TABFAC(2)='ALP1'
  903. TABFAC(3)='ALP2'
  904. TABFAC(4)='AL12'
  905. TABFAC(5)='ALP3'
  906.  
  907. ELSEIF (IFOUR.EQ.1) THEN
  908. * AXISYMETRIE DE FOURIER
  909. JGOBL=15
  910. TABOBL(1)='D11 '
  911. TABOBL(2)='D21 '
  912. TABOBL(3)='D22 '
  913. TABOBL(4)='D31 '
  914. TABOBL(5)='D32 '
  915. TABOBL(6)='D33 '
  916. TABOBL(7)='D41 '
  917. TABOBL(8)='D42 '
  918. TABOBL(9)='D43 '
  919. TABOBL(10)='D44 '
  920. TABOBL(11)='D55 '
  921. TABOBL(12)='D65 '
  922. TABOBL(13)='D66 '
  923. TABOBL(14)='V1X '
  924. TABOBL(15)='V1Y '
  925. *
  926. JGFAC=5
  927. TABFAC(1)='RHO '
  928. TABFAC(2)='ALP1'
  929. TABFAC(3)='ALP2'
  930. TABFAC(4)='AL12'
  931. TABFAC(5)='ALP3'
  932. ENDIF
  933. ENDIF
  934. ENDIF
  935.  
  936. ELSEIF (IPLAC.EQ.4) THEN
  937. IF (MFR.EQ.33) THEN
  938. * MILIEU POREUX ISOTROPE
  939. *
  940. JGOBL=12
  941. TABOBL(1) ='YOUN'
  942. TABOBL(2) ='NU '
  943. TABOBL(3) ='RHO '
  944. TABOBL(4) ='ALPH'
  945. TABOBL(5) ='COB '
  946. TABOBL(6) ='MOB '
  947. TABOBL(7) ='ALPM'
  948. TABOBL(8) ='PERM'
  949. TABOBL(9) ='VISC'
  950. TABOBL(10)='KF '
  951. TABOBL(11)='RHOF'
  952. TABOBL(12)='ALPF'
  953. *
  954. IF (IFOUR.EQ.-2) THEN
  955. JGFAC=1
  956. TABFAC(1)='DIM3'
  957. ENDIF
  958. ENDIF
  959.  
  960. ELSEIF (IPLAC.EQ.5) THEN
  961. IF (MFR.EQ.37) THEN
  962. * MILIEU HOMOGENEISE
  963. *
  964. JGOBL=16
  965. TABOBL( 1)='B11 '
  966. TABOBL( 2)='B22 '
  967. TABOBL( 3)='B12 '
  968. TABOBL( 4)='ROF '
  969. TABOBL( 5)='ROS '
  970. TABOBL( 6)='YOUN'
  971. TABOBL( 7)='CSON'
  972. TABOBL( 8)='RORF'
  973. TABOBL( 9)='CREF'
  974. TABOBL(10)='LCAR'
  975. TABOBL(11)='E111'
  976. TABOBL(12)='E112'
  977. TABOBL(13)='E121'
  978. TABOBL(14)='E122'
  979. TABOBL(15)='E221'
  980. TABOBL(16)='E222'
  981. ENDIF
  982. ELSEIF (IPLAC.EQ.6) THEN
  983. C
  984. C MATERIAU ELASTIQUE UNIDIRECTIONNEL
  985. C
  986. IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN
  987. JGOBL=7
  988. TABOBL(1)='YOUN'
  989. TABOBL(2)='V1X '
  990. TABOBL(3)='V1Y '
  991. TABOBL(4)='V1Z '
  992. TABOBL(5)='V2X '
  993. TABOBL(6)='V2Y '
  994. TABOBL(7)='V2Z '
  995.  
  996. ELSE
  997. JGOBL=3
  998. TABOBL(1)='YOUN'
  999. TABOBL(2)='V1X '
  1000. TABOBL(3)='V1Y '
  1001. ENDIF
  1002.  
  1003. IF((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31).AND.
  1004. . IFOUR.EQ.-2) THEN
  1005. JGFAC=3
  1006. TABFAC(3)='DIM3'
  1007. ELSE
  1008. JGFAC=2
  1009. ENDIF
  1010. TABFAC(1)='RHO '
  1011. TABFAC(2)='ALPH'
  1012.  
  1013. ELSEIF (IPLAC.EQ.7) THEN
  1014. C MODELE ET MATERIAU DE LA SECTION DU MODELE A FIBRE
  1015. C
  1016. JGOBL=2
  1017. TABOBL(1)='MODS'
  1018. TABOBL(2)='MATS'
  1019.  
  1020. JGFAC=1
  1021. TABFAC(1)='MANO'
  1022. C ---- IPLAC 8: Ajoute par Jiang, 22/08/1995 et fleuret 28/05/96
  1023.  
  1024. ELSEIF (IPLAC.EQ.8) THEN
  1025. C MODELE ET MATERIAU POUR LE CABLE PRECONTRAINT
  1026. C
  1027. JGOBL=1
  1028. TABOBL(1)='YOUN'
  1029.  
  1030. JGFAC=8
  1031. TABFAC(1)='FF'
  1032. TABFAC(2)='PHIF'
  1033. TABFAC(3)='GANC'
  1034. TABFAC(4)='RMU0'
  1035. TABFAC(5)='FPRG'
  1036. TABFAC(6)='RH10'
  1037. TABFAC(7)='ALPH'
  1038. TABFAC(8)='RHO '
  1039.  
  1040. ELSEIF (IPLAC.EQ.9) THEN
  1041. C MODAL
  1042. C
  1043. JGOBL=3
  1044. TABOBL(1)='FREQ'
  1045. TABOBL(2)='MASS'
  1046. TABOBL(3)='DEFO'
  1047.  
  1048. JGFAC = 9
  1049. TABFAC(1) = 'AMOR'
  1050. TABFAC(2) = 'CGRA'
  1051. TABFAC(3) = 'MADE'
  1052. TABFAC(4) = 'RICR'
  1053. TABFAC(5) = 'MAIB'
  1054. TABFAC(6) = 'MACR'
  1055. TABFAC(7) = 'AMCR'
  1056. TABFAC(8) = 'ALP0'
  1057. TABFAC(9) = 'ECRO'
  1058.  
  1059. ELSEIF (IPLAC.EQ.10) THEN
  1060. C STATIQUE
  1061. C
  1062. JGOBL=3
  1063. TABOBL(1)='DEFO'
  1064. TABOBL(2)='RIDE'
  1065. TABOBL(3)='MADE'
  1066.  
  1067. JGFAC = 8
  1068. TABFAC(1) = 'AMOR'
  1069. TABFAC(2) = 'RICR'
  1070. TABFAC(3) = 'MAIA'
  1071. TABFAC(4) = 'MAIB'
  1072. TABFAC(5) = 'MACR'
  1073. TABFAC(6) = 'AMCR'
  1074. TABFAC(7) = 'BET0'
  1075. TABFAC(8) = 'ECRO'
  1076.  
  1077. ELSEIF (IPLAC.EQ.11) THEN
  1078. C ZONE_COHESIVE
  1079. C
  1080. JGOBL=2
  1081. TABOBL(1)='KS'
  1082. TABOBL(2)='KN'
  1083. ENDIF
  1084.  
  1085. INMAT=3
  1086. GOTO 20
  1087.  
  1088. ELSE
  1089. INMAT=2
  1090. GOTO 10
  1091. ENDIF
  1092. ENDIF
  1093. INMAT=0
  1094. 10 CONTINUE
  1095. *
  1096. * MATERIAU ELASTIQUE ISOTROPE
  1097. *
  1098. IF (MFR.EQ.35) THEN
  1099. * VALABLE EN 2D COMME EN 3D
  1100. JGOBL=2
  1101. TABOBL(1)='KS '
  1102. TABOBL(2)='KN '
  1103.  
  1104. JGFAC=2
  1105. TABFAC(1)='RHO '
  1106. TABFAC(2)='ALPN'
  1107. *
  1108. ELSE IF (MFR.EQ.78) THEN
  1109. * VALABLE EN 2D COMME EN 3D
  1110. JGOBL=2
  1111. TABOBL(1)='KS '
  1112. TABOBL(2)='KN '
  1113. *
  1114. * JOINT CISAILLEMENT (2D)
  1115. *
  1116. ELSEIF (MFR.EQ.53) THEN
  1117. * VALABLE EN 2D "COMME EN 3D"
  1118.  
  1119. JGOBL=1
  1120. TABOBL(1)='KS '
  1121. *
  1122. JGFAC=2
  1123. TABFAC(1)='RHO '
  1124. TABFAC(2)='ALPN'
  1125. *
  1126. * TOUS LES AUTRES CAS
  1127. *
  1128. ELSE
  1129. JGOBL=2
  1130. TABOBL(1)='YOUN'
  1131. TABOBL(2)='NU '
  1132. *
  1133. IF((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.63).AND.
  1134. . IFOUR.EQ.-2) THEN
  1135. JGFAC=4
  1136. TABFAC(3)='DIM3'
  1137. TABFAC(4)='VISQ'
  1138. ELSE
  1139. JGFAC=3
  1140. TABFAC(3)='VISQ'
  1141. ENDIF
  1142. TABFAC(1)='RHO '
  1143. TABFAC(2)='ALPH'
  1144.  
  1145. * AM CAS FORMULATION NON-LOCALE
  1146.  
  1147. INLOC = 0
  1148. MN3 = INFMOD(/1)
  1149. IF (MN3.GE.13) INLOC=-1*INFMOD(13)
  1150. IF (INLOC.GT.0) THEN
  1151. JGM0 = JGFAC
  1152. * moyenne
  1153. IF(INLOC.EQ.1) THEN
  1154. JGFAC=JGM0+1
  1155. TABFAC(JGM0+1)='LCAR'
  1156. * stress-based
  1157. ELSE IF(INLOC.EQ.2) THEN
  1158. JGFAC=JGM0+2
  1159. TABFAC(JGM0+1)='LCAR'
  1160. TABFAC(JGM0+2)='SBFT'
  1161.  
  1162. * helmholtz
  1163. ELSE IF(INLOC.EQ.3) THEN
  1164. JGFAC=JGM0+6
  1165. TABFAC(JGM0+1)='LCAR'
  1166. TABFAC(JGM0+2)='LCF1'
  1167. TABFAC(JGM0+3)='LCF2'
  1168. TABFAC(JGM0+4)='LCF3'
  1169. TABFAC(JGM0+5)='LCF4'
  1170. TABFAC(JGM0+6)='LCF5'
  1171. * cas non prevu
  1172. ELSE
  1173. IRET = 0
  1174. CALL ERREUR(5)
  1175. ENDIF
  1176. ENDIF
  1177. *
  1178. ENDIF
  1179. *
  1180. IF (INMAT.EQ.0) GOTO 9999
  1181. *
  1182. 19 CONTINUE
  1183. 20 CONTINUE
  1184. DO jm = 1,matmod(/2)
  1185. IF (matmod(jm).eq.'IMPEDANCE') THEN
  1186. imate = imatee
  1187. INMAT = INMAT + 1
  1188. JGOBL = 0
  1189. JGFAC = 0
  1190.  
  1191. IF(CMATEE.EQ.'IMPELAST') THEN
  1192. *IMPE_ELAS
  1193. JGM0 = JGOBL
  1194. JGOBL= JGM0+1
  1195. TABOBL(JGM0 + 1) ='RAID'
  1196. JGM0 = JGFAC
  1197.  
  1198. JGFAC = JGM0+4
  1199. TABFAC(JGM0+1) = 'AMOR'
  1200. TABFAC(JGM0+2) = 'ZNU'
  1201. TABFAC(JGM0+3) = 'MASS'
  1202. TABFAC(JGM0+4) = 'ALPH'
  1203. GOTO 22
  1204. ELSEIF (CMATEE.EQ.'IMPVOIGT'.or.CMATEE.EQ.'IMPREUSS') THEN
  1205. *IMPE_VOIGT ou IMPE_REUSS
  1206. JGM0 = JGOBL
  1207. JGOBL= JGM0+2
  1208. TABOBL(JGM0 + 1) ='RAID'
  1209. TABOBL(JGM0 + 2) ='VISC'
  1210.  
  1211. JGM0 = JGFAC
  1212. JGFAC = JGM0+2
  1213. TABFAC(JGM0+1) = 'MASS'
  1214. TABFAC(JGM0+2) = 'AMOR'
  1215. GOTO 22
  1216. ELSEIF (CMATEE.EQ.'IMPCOMPL') then
  1217. *IMPE_COMPLEXE
  1218. JGM0 = JGOBL
  1219. JGOBL= JGM0+1
  1220. TABOBL(JGM0 + 1) ='MOCO'
  1221.  
  1222. JGM0 = JGFAC
  1223. JGFAC = JGFAC+4
  1224. TABFAC(JGM0+1) = 'RAID'
  1225. TABFAC(JGM0+2) = 'VISC'
  1226. TABFAC(JGM0+3) = 'MASS'
  1227. TABFAC(JGM0+4) = 'AMOR'
  1228. GOTO 22
  1229. ELSE
  1230. ENDIF
  1231. 22 CONTINUE
  1232. * if (mele.eq.45) then
  1233. JGM0 = JGFAC
  1234. JGFAC = JGM0+3
  1235.  
  1236. IF(CMATEE.EQ.'IMPELAST') THEN
  1237. TABFAC(JGM0+1) = TABFAC(JGM0-2)
  1238. TABFAC(JGM0+2) = TABFAC(JGM0-1)
  1239. TABFAC(JGM0+3) = TABFAC(JGM0)
  1240. TABFAC(JGM0-2) = 'CPLE'
  1241. TABFAC(JGM0-1) = 'INER'
  1242. TABFAC(JGM0) = 'AROT'
  1243. ELSE
  1244. TABFAC(JGM0+1) = 'CPLE'
  1245. TABFAC(JGM0+2) = 'INER'
  1246. TABFAC(JGM0+3) = 'AROT'
  1247. ENDIF
  1248. * endif
  1249. IF (NMAT.GE.INMAT) inmat = inmat+1
  1250. * GOTO 9999
  1251. ENDIF
  1252. ENDDO
  1253. *
  1254. IF (NMAT.GE.INMAT) THEN
  1255. CALL MODNLI(MOMODL,NMOD)
  1256. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1257. IF (IPLAC.EQ.1) THEN
  1258. INMAT=INMAT+1
  1259. CALL MODPLA(MOMODL,NMOD)
  1260. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1261. IF (IPLAC.EQ.0) THEN
  1262. * ISOTROPE
  1263. IPLAC=1
  1264. * ELSE
  1265. * INMAT=INMAT+1
  1266. ENDIF
  1267. CALL IDPLAS(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1268. ELSEIF (IPLAC.EQ.2) THEN
  1269. INMAT=INMAT+1
  1270. CALL MODFLU(MOMODL,NMOD)
  1271. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1272. IF (IPLAC.EQ.0) THEN
  1273. * NORTON
  1274. IPLAC=1
  1275. * ELSE
  1276. * INMAT=INMAT+1
  1277. ENDIF
  1278. CALL IDFLUA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1279. ELSEIF (IPLAC.EQ.3) THEN
  1280. INMAT=INMAT+1
  1281. CALL MODVIS(MOMODL,NMOD)
  1282. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1283. IF (IPLAC.EQ.0) THEN
  1284. * ONERA
  1285. IPLAC=2
  1286. * ELSE
  1287. * INMAT=INMAT+1
  1288. ENDIF
  1289. C
  1290. C Cas particulier des modeles GATT_MONERIE et UO2
  1291. C 'RHO ' et 'ALPH' sont obligatoires
  1292. IF (IPLAC.EQ.18.OR.IPLAC.EQ.19) THEN
  1293. JGM0 = JGOBL
  1294. JGOBL=JGM0+2
  1295. TABOBL(JGM0+1)='RHO '
  1296. TABOBL(JGM0+2)='ALPH'
  1297.  
  1298. JGM0=JGFAC
  1299. JGFAC=JGM0-2
  1300. IF (JGFAC.GT.0) THEN
  1301. DO 200 I=1,JGFAC
  1302. TABFAC(I)=TABFAC(I+2)
  1303. 200 CONTINUE
  1304. ENDIF
  1305.  
  1306. C ===
  1307. C Modeles SYMONDS & COWPER SYCO1 et SYCO2
  1308. C ===
  1309. ELSEIF (IPLAC.EQ.28) THEN
  1310. JGM0=JGOBL
  1311. JGOBL=JGM0+1
  1312. TABOBL(JGM0+1)='ECRO'
  1313.  
  1314. ELSEIF (IPLAC.EQ.29) THEN
  1315. JGM0=JGOBL
  1316. JGOBL=JGM0+1
  1317. TABOBL(JGM0+1)='ECRO'
  1318. ENDIF
  1319. CALL IDVISC(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1320. C
  1321. ELSEIF (IPLAC.EQ.4) THEN
  1322. INMAT=INMAT+1
  1323. CALL MODEND(MOMODL,NMOD)
  1324. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1325. IF (IPLAC.EQ.0) THEN
  1326. * MAZARS
  1327. IPLAC=1
  1328. * ELSE
  1329. * INMAT=INMAT+1
  1330. ENDIF
  1331. CALL IDENDO(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1332. ELSEIF (IPLAC.EQ.5) THEN
  1333. INMAT=INMAT+1
  1334. CALL MODPLE(MOMODL,NMOD)
  1335. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1336. IF (IPLAC.EQ.0) THEN
  1337. * TRIAXIAL P/Y
  1338. IPLAC=1
  1339. * ELSE
  1340. * INMAT=INMAT+1
  1341. ENDIF
  1342. CALL IDPLEN(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1343. ELSEIF (IPLAC.EQ.6) THEN
  1344. INMAT=INMAT+1
  1345. CALL MODENL(MOMODL,NMOD)
  1346. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  1347. IF (IPLAC.EQ.0) THEN
  1348. * ISOTROPE
  1349. IPLAC=1
  1350. * ELSE
  1351. * INMAT=INMAT+1
  1352. ENDIF
  1353. CALL IDELNL(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  1354. ELSEIF (IPLAC.EQ.7) THEN
  1355. C Pas de composantes supplementaires pour une loi 'VISCO_EXTERNE'
  1356. IRET = 1
  1357. ELSEIF(IPLAC.EQ.0.AND.IMATEE.EQ.31) THEN
  1358. GOTO 9999
  1359. ELSE
  1360. GOTO 9999
  1361. ENDIF
  1362. C IRET code retour de IDPLAS,IDFLUA,IDVISC,IDENDO,IDPLEN,IDELNL
  1363. IF (IRET.EQ.0) GOTO 9999
  1364. ENDIF
  1365.  
  1366. * Parametres CRIP et FUSION :
  1367. do jma=1,matmod(/2)
  1368. if(matmod(jma).eq.'CRIP') then
  1369. JGOBL = JGOBL + 1
  1370. TABOBL(JGOBL) = 'LIMP'
  1371.  
  1372. elseif(matmod(jma).eq.'FUSION') then
  1373. JGOBL = JGOBL + 1
  1374. TABOBL(JGOBL) = 'TFUS'
  1375.  
  1376. endif
  1377. enddo
  1378. *
  1379. GOTO 9999
  1380. ENDIF
  1381.  
  1382. *--------------------------------------------------------------------
  1383. * CAS DE LA FORMULATION POREUX
  1384. *--------------------------------------------------------------------
  1385. CALL PLACE(FORMOD,NFOR,IPORE,'POREUX')
  1386. IF (IPORE.NE.0) THEN
  1387. *
  1388. CALL MODLIN(MOMODL,NMOD)
  1389. CALL PLACE(MOMODL,NMOD,IRET,MATMOD(1))
  1390. IF (IRET.EQ.0) GOTO 9999
  1391. *
  1392. * D'ABORD : CAS NON ISOTROPE
  1393. *
  1394. IF (NMAT.GE.2) THEN
  1395. CALL MODELA(MOMODL,NMOD)
  1396. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(2))
  1397. IF (IPLAC.NE.0) THEN
  1398. INMAT=3
  1399. IF (IPLAC.EQ.1) THEN
  1400. INMAT=3
  1401. GOTO 30
  1402. ENDIF
  1403. IF (IPLAC.EQ.2) THEN
  1404. *
  1405. * MATERIAU ELASTIQUE ORTHOTROPE
  1406. *
  1407. IF (MFR.EQ.33) THEN
  1408. *
  1409. * ELEMENTS MASSIFS
  1410. *
  1411. IF(IDIM.EQ.3)THEN
  1412. * ELEMENTS 3D
  1413. JGOBL=19
  1414. TABOBL(1)='YG1 '
  1415. TABOBL(2)='YG2 '
  1416. TABOBL(3)='YG3 '
  1417. TABOBL(4)='NU12'
  1418. TABOBL(5)='NU23'
  1419. TABOBL(6)='NU13'
  1420. TABOBL(7)='G12 '
  1421. TABOBL(8)='G23 '
  1422. TABOBL(9)='G13 '
  1423. TABOBL(10)='V1X '
  1424. TABOBL(11)='V1Y '
  1425. TABOBL(12)='V1Z '
  1426. TABOBL(13)='V2X '
  1427. TABOBL(14)='V2Y '
  1428. TABOBL(15)='V2Z '
  1429. TABOBL(16)='COB1'
  1430. TABOBL(17)='COB2'
  1431. TABOBL(18)='COB3'
  1432. TABOBL(19)='MOB '
  1433. *
  1434. JGFAC=12
  1435. TABFAC(1)='RHO '
  1436. TABFAC(2)='ALP1'
  1437. TABFAC(3)='ALP2'
  1438. TABFAC(4)='ALP3'
  1439. TABFAC(5)='ALPM'
  1440. TABFAC(6)='PER1'
  1441. TABFAC(7)='PER2'
  1442. TABFAC(8)='PER3'
  1443. TABFAC(9)='VISC'
  1444. TABFAC(10)='KF '
  1445. TABFAC(11)='RHOF'
  1446. TABFAC(12)='ALPF'
  1447. ELSEIF (IDIM.EQ.2) THEN
  1448. IF(IFOUR.EQ.-2)THEN
  1449. * CONTRAINTE PLANE
  1450. JGOBL=12
  1451. TABOBL(1)='YG1 '
  1452. TABOBL(2)='YG2 '
  1453. TABOBL(3)='NU12'
  1454. TABOBL(4)='G12 '
  1455. TABOBL(5)='V1X '
  1456. TABOBL(6)='V1Y '
  1457. TABOBL(7)='COB1'
  1458. TABOBL(8)='COB2'
  1459. TABOBL(9)='MOB '
  1460. TABOBL(10)='YG3 '
  1461. TABOBL(11)='NU23'
  1462. TABOBL(12)='NU13'
  1463. *
  1464. JGFAC=11
  1465. TABFAC(1)='RHO '
  1466. TABFAC(2)='ALP1'
  1467. TABFAC(3)='ALP2'
  1468. TABFAC(4)='ALPM'
  1469. TABFAC(5)='PER1'
  1470. TABFAC(6)='PER2'
  1471. TABFAC(7)='VISC'
  1472. TABFAC(8)='KF '
  1473. TABFAC(9)='RHOF'
  1474. TABFAC(10)='ALPF'
  1475. TABFAC(11)='DIM3'
  1476. ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  1477. * DEFORMATION PLANE ,AXISYMETRIE
  1478. JGOBL=13
  1479. TABOBL(1)='YG1 '
  1480. TABOBL(2)='YG2 '
  1481. TABOBL(3)='YG3 '
  1482. TABOBL(4)='NU12'
  1483. TABOBL(5)='NU23'
  1484. TABOBL(6)='NU13'
  1485. TABOBL(7)='G12 '
  1486. TABOBL(8)='V1X '
  1487. TABOBL(9)='V1Y '
  1488. TABOBL(10)='COB1'
  1489. TABOBL(11)='COB2'
  1490. TABOBL(12)='COB3'
  1491. TABOBL(13)='MOB '
  1492. *
  1493. JGFAC=11
  1494. TABFAC(1)='RHO '
  1495. TABFAC(2)='ALP1'
  1496. TABFAC(3)='ALP2'
  1497. TABFAC(4)='ALP3'
  1498. TABFAC(5)='ALPM'
  1499. TABFAC(6)='PER1'
  1500. TABFAC(7)='PER2'
  1501. TABFAC(8)='VISC'
  1502. TABFAC(9)='KF '
  1503. TABFAC(10)='RHOF'
  1504. TABFAC(11)='ALPF'
  1505. *
  1506. ELSEIF (IFOUR.EQ.1) THEN
  1507. * AXISYMETRIE DE FOURIER
  1508. JGOBL=15
  1509. TABOBL(1)='YG1 '
  1510. TABOBL(2)='YG2 '
  1511. TABOBL(3)='YG3 '
  1512. TABOBL(4)='NU12'
  1513. TABOBL(5)='NU23'
  1514. TABOBL(6)='NU13'
  1515. TABOBL(7)='G12 '
  1516. TABOBL(8)='G23 '
  1517. TABOBL(9)='G13 '
  1518. TABOBL(10)='V1X '
  1519. TABOBL(11)='V1Y '
  1520. TABOBL(12)='COB1'
  1521. TABOBL(13)='COB2'
  1522. TABOBL(14)='COB3'
  1523. TABOBL(15)='MOB '
  1524. *
  1525. JGFAC=12
  1526. TABFAC(1)='RHO '
  1527. TABFAC(2)='ALP1'
  1528. TABFAC(3)='ALP2'
  1529. TABFAC(4)='ALP3'
  1530. TABFAC(5)='ALPM'
  1531. TABFAC(6)='PER1'
  1532. TABFAC(7)='PER2'
  1533. TABFAC(8)='PER3'
  1534. TABFAC(9)='VISC'
  1535. TABFAC(10)='KF '
  1536. TABFAC(11)='RHOF'
  1537. TABFAC(12)='ALPF'
  1538. ENDIF
  1539. ENDIF
  1540. ELSE
  1541. *
  1542. * CAS NON PREVU
  1543. *
  1544. IRET = 0
  1545. GOTO 9999
  1546. ENDIF
  1547. ELSEIF (IPLAC.EQ.3)THEN
  1548. *
  1549. * MATERIAU ANISOTROPE ELASTIQUE
  1550. *
  1551. IF(MFR.EQ.33)THEN
  1552. *
  1553. * ELEMENTS MASSIFS
  1554. *
  1555. IF(IDIM.EQ.3)THEN
  1556. * ELEMENTS 3D
  1557. JGOBL=34
  1558. TABOBL(1)='D11 '
  1559. TABOBL(2)='D21 '
  1560. TABOBL(3)='D22 '
  1561. TABOBL(4)='D31 '
  1562. TABOBL(5)='D32 '
  1563. TABOBL(6)='D33 '
  1564. TABOBL(7)='D41 '
  1565. TABOBL(8)='D42 '
  1566. TABOBL(9)='D43 '
  1567. TABOBL(10)='D44 '
  1568. TABOBL(11)='D51 '
  1569. TABOBL(12)='D52 '
  1570. TABOBL(13)='D53 '
  1571. TABOBL(14)='D54 '
  1572. TABOBL(15)='D55 '
  1573. TABOBL(16)='D61 '
  1574. TABOBL(17)='D62 '
  1575. TABOBL(18)='D63 '
  1576. TABOBL(19)='D64 '
  1577. TABOBL(20)='D65 '
  1578. TABOBL(21)='D66 '
  1579. TABOBL(22)='V1X '
  1580. TABOBL(23)='V1Y '
  1581. TABOBL(24)='V1Z '
  1582. TABOBL(25)='V2X '
  1583. TABOBL(26)='V2Y '
  1584. TABOBL(27)='V2Z '
  1585. TABOBL(28)='COB1'
  1586. TABOBL(29)='COB2'
  1587. TABOBL(30)='COB3'
  1588. TABOBL(31)='CO12'
  1589. TABOBL(32)='CO13'
  1590. TABOBL(33)='CO23'
  1591. TABOBL(34)='MOB '
  1592. *
  1593. JGFAC=18
  1594. TABFAC(1)='RHO '
  1595. TABFAC(2)='ALP1'
  1596. TABFAC(3)='ALP2'
  1597. TABFAC(4)='ALP3'
  1598. TABFAC(5)='AL12'
  1599. TABFAC(6)='AL13'
  1600. TABFAC(7)='AL23'
  1601. TABFAC(8)='ALPM'
  1602. TABFAC(9 )='PER1'
  1603. TABFAC(10)='PER2'
  1604. TABFAC(11)='PER3'
  1605. TABFAC(12)='PE12'
  1606. TABFAC(13)='PE13'
  1607. TABFAC(14)='PE23'
  1608. TABFAC(15)='VISC'
  1609. TABFAC(16)='KF '
  1610. TABFAC(17)='RHOF'
  1611. TABFAC(18)='ALPF'
  1612. ELSEIF (IDIM.EQ.2) THEN
  1613. IF (IFOUR.EQ.-2) THEN
  1614. * CONTRAINTE PLANE
  1615. JGOBL=16
  1616. TABOBL(1)='D11 '
  1617. TABOBL(2)='D21 '
  1618. TABOBL(3)='D22 '
  1619. TABOBL(4)='D41 '
  1620. TABOBL(5)='D42 '
  1621. TABOBL(6)='D44 '
  1622. TABOBL(7)='V1X '
  1623. TABOBL(8)='V1Y '
  1624. TABOBL(9 )='COB1'
  1625. TABOBL(10)='COB2'
  1626. TABOBL(11)='CO12'
  1627. TABOBL(12)='MOB '
  1628. TABOBL(13)='D31 '
  1629. TABOBL(14)='D32 '
  1630. TABOBL(15)='D33 '
  1631. TABOBL(16)='D43 '
  1632. *
  1633. JGFAC=13
  1634. TABFAC(1)='RHO '
  1635. TABFAC(2)='ALP1'
  1636. TABFAC(3)='ALP2'
  1637. TABFAC(4)='AL12'
  1638. TABFAC(5)='ALPM'
  1639. TABFAC(6)='PER1'
  1640. TABFAC(7)='PER2'
  1641. TABFAC(8)='PE12'
  1642. TABFAC(9)='VISC'
  1643. TABFAC(10)='KF '
  1644. TABFAC(11)='RHOF'
  1645. TABFAC(12)='ALPF'
  1646. TABFAC(13)='DIM3'
  1647. *
  1648. ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  1649. * DEFORMATION PLANE ,AXISYMETRIE
  1650. JGOBL=17
  1651. TABOBL(1)='D11 '
  1652. TABOBL(2)='D21 '
  1653. TABOBL(3)='D22 '
  1654. TABOBL(4)='D31 '
  1655. TABOBL(5)='D32 '
  1656. TABOBL(6)='D33 '
  1657. TABOBL(7)='D41 '
  1658. TABOBL(8)='D42 '
  1659. TABOBL(9)='D43 '
  1660. TABOBL(10)='D44 '
  1661. TABOBL(11)='V1X '
  1662. TABOBL(12)='V1Y '
  1663. TABOBL(13)='COB1'
  1664. TABOBL(14)='COB2'
  1665. TABOBL(15)='CO12'
  1666. TABOBL(16)='COB3'
  1667. TABOBL(17)='MOB '
  1668. *
  1669. JGFAC=13
  1670. TABFAC(1)='RHO '
  1671. TABFAC(2)='ALP1'
  1672. TABFAC(3)='ALP2'
  1673. TABFAC(4)='AL12'
  1674. TABFAC(5)='ALP3'
  1675. TABFAC(6)='ALPM'
  1676. TABFAC(7)='PER1'
  1677. TABFAC(8)='PER2'
  1678. TABFAC(9)='PE12'
  1679. TABFAC(10)='VISC'
  1680. TABFAC(11)='KF '
  1681. TABFAC(12)='RHOF'
  1682. TABFAC(13)='ALPF'
  1683. *
  1684. ELSEIF (IFOUR.EQ.1) THEN
  1685. * AXISYMETRIE DE FOURIER
  1686. JGOBL=20
  1687. TABOBL(1)='D11 '
  1688. TABOBL(2)='D21 '
  1689. TABOBL(3)='D22 '
  1690. TABOBL(4)='D31 '
  1691. TABOBL(5)='D32 '
  1692. TABOBL(6)='D33 '
  1693. TABOBL(7)='D41 '
  1694. TABOBL(8)='D42 '
  1695. TABOBL(9)='D43 '
  1696. TABOBL(10)='D44 '
  1697. TABOBL(11)='D55 '
  1698. TABOBL(12)='D65 '
  1699. TABOBL(13)='D66 '
  1700. TABOBL(14)='V1X '
  1701. TABOBL(15)='V1Y '
  1702. TABOBL(16)='COB1'
  1703. TABOBL(17)='COB2'
  1704. TABOBL(18)='CO12'
  1705. TABOBL(19)='COB3'
  1706. TABOBL(20)='MOB '
  1707. *
  1708. JGFAC=14
  1709. TABFAC(1)='RHO '
  1710. TABFAC(2)='ALP1'
  1711. TABFAC(3)='ALP2'
  1712. TABFAC(4)='AL12'
  1713. TABFAC(5)='ALP3'
  1714. TABFAC(6)='ALPM'
  1715. TABFAC(7)='PER1'
  1716. TABFAC(8)='PER2'
  1717. TABFAC(9)='PE12'
  1718. TABFAC(10)='PER3'
  1719. TABFAC(11)='VISC'
  1720. TABFAC(12)='KF '
  1721. TABFAC(13)='RHOF'
  1722. TABFAC(14)='ALPF'
  1723. ENDIF
  1724. ENDIF
  1725. ELSE
  1726. *
  1727. * CAS NON PREVU
  1728. *
  1729. IRET = 0
  1730. GOTO 9999
  1731. ENDIF
  1732.  
  1733. ELSEIF (IPLAC.EQ.6) THEN
  1734. C
  1735. C MATERIAU ELASTIQUE UNIDIRECTIONNEL
  1736. C
  1737. IF(MFR.EQ.33)THEN
  1738. IF (IDIM.EQ.3) THEN
  1739. JGOBL=9
  1740. TABOBL(1)='YOUN'
  1741. TABOBL(2)='V1X '
  1742. TABOBL(3)='V1Y '
  1743. TABOBL(4)='V1Z '
  1744. TABOBL(5)='V2X '
  1745. TABOBL(6)='V2Y '
  1746. TABOBL(7)='V2Z '
  1747. TABOBL(8)='COB '
  1748. TABOBL(9)='MOB '
  1749. ELSE
  1750. JGOBL=5
  1751. TABOBL(1)='YOUN'
  1752. TABOBL(2)='V1X '
  1753. TABOBL(3)='V1Y '
  1754. TABOBL(4)='COB '
  1755. TABOBL(5)='MOB '
  1756. ENDIF
  1757. *
  1758. IF(IFOUR.EQ.-2) THEN
  1759. JGFAC=9
  1760. TABFAC(9)='DIM3'
  1761. ELSE
  1762. JGFAC=8
  1763. ENDIF
  1764. TABFAC(1)='RHO '
  1765. TABFAC(2)='ALPH'
  1766. TABFAC(3)='ALPM'
  1767. TABFAC(4)='PERM'
  1768. TABFAC(5)='VISC'
  1769. TABFAC(6)='KF '
  1770. TABFAC(7)='RHOF'
  1771. TABFAC(8)='ALPF'
  1772. ELSE
  1773. *
  1774. * CAS NON PREVU
  1775. *
  1776. IRET = 0
  1777. GO TO 9999
  1778. ENDIF
  1779. *
  1780. ENDIF
  1781. INMAT=3
  1782. GOTO 40
  1783. ELSE
  1784. INMAT=2
  1785. GOTO 30
  1786. ENDIF
  1787. ENDIF
  1788. INMAT=0
  1789. 30 CONTINUE
  1790. *
  1791. * CAS MATERIAU POREUX ELASTIQUE ISOTROPE
  1792. *
  1793. IF(MELE.GE.79.AND.MELE.LE.83)THEN
  1794. *
  1795. JGOBL=4
  1796. TABOBL(1) ='YOUN'
  1797. TABOBL(2) ='NU '
  1798. TABOBL(3) ='COB '
  1799. TABOBL(4) ='MOB '
  1800. *
  1801. IF(IFOUR.EQ.-2) THEN
  1802. JGFAC=9
  1803. TABFAC(9)='DIM3'
  1804. ELSE
  1805. JGFAC=8
  1806. ENDIF
  1807. TABFAC(1)='RHOF'
  1808. TABFAC(2)='ALPF'
  1809. TABFAC(3)='ALPM'
  1810. TABFAC(4)='PERM'
  1811. TABFAC(5)='VISC'
  1812. TABFAC(6)='KF '
  1813. TABFAC(7)='RHO '
  1814. TABFAC(8)='ALPH'
  1815. *
  1816. ELSEIF(MELE.GE.108.AND.MELE.LE.110)THEN
  1817. *
  1818. * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D)
  1819. *
  1820. JGOBL=4
  1821. TABOBL(1)='KS '
  1822. TABOBL(2)='KN '
  1823. TABOBL(3)='COB '
  1824. TABOBL(4)='MOB '
  1825. *
  1826. JGFAC=4
  1827. TABFAC(1)='PERT'
  1828. TABFAC(2)='PERH'
  1829. TABFAC(3)='PERB'
  1830. TABFAC(4)='VISC'
  1831. *
  1832. ELSEIF(MELE.GE.173.AND.MELE.LE.177)THEN
  1833. *
  1834. JGOBL=10
  1835. TABOBL(1) ='YOUN'
  1836. TABOBL(2) ='NU '
  1837. TABOBL(3) ='COP1'
  1838. TABOBL(4) ='COP2'
  1839. TABOBL(5) ='CPP1'
  1840. TABOBL(6) ='CPP2'
  1841. TABOBL(7) ='KK11'
  1842. TABOBL(8) ='KK12'
  1843. TABOBL(9) ='KK21'
  1844. TABOBL(10)='KK22'
  1845. *
  1846. IF(IFOUR.EQ.-2) THEN
  1847. JGFAC=9
  1848. TABFAC(9)='DIM3'
  1849. ELSE
  1850. JGFAC=8
  1851. ENDIF
  1852. TABFAC(1)='RHOF'
  1853. TABFAC(2)='ALPF'
  1854. TABFAC(3)='ALPM'
  1855. TABFAC(4)='PK11'
  1856. TABFAC(5)='PK12'
  1857. TABFAC(6)='PK21'
  1858. TABFAC(7)='PK22'
  1859. TABFAC(8)='ALPH'
  1860. *
  1861. ELSEIF(MELE.GE.185.AND.MELE.LE.187)THEN
  1862. *
  1863. * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D)
  1864. *
  1865. JGOBL=10
  1866. TABOBL(1)='KS '
  1867. TABOBL(2)='KN '
  1868. TABOBL(3)='COP1'
  1869. TABOBL(4)='COP2'
  1870. TABOBL(5)='CPP1'
  1871. TABOBL(6)='CPP2'
  1872. TABOBL(7)='KK11'
  1873. TABOBL(8)='KK12'
  1874. TABOBL(9)='KK21'
  1875. TABOBL(10)='KK22'
  1876. *
  1877. IF(IFOUR.EQ.-2) THEN
  1878. JGFAC=18
  1879. TABFAC(18)='DIM3'
  1880. ELSE
  1881. JGFAC=17
  1882. ENDIF
  1883. TABFAC(1)='RHOF'
  1884. TABFAC(2)='ALPF'
  1885. TABFAC(3)='ALPM'
  1886. TABFAC(4)='PT11'
  1887. TABFAC(5)='PH11'
  1888. TABFAC(6)='PB11'
  1889. TABFAC(7)='PT12'
  1890. TABFAC(8)='PH12'
  1891. TABFAC(9)='PB12'
  1892. TABFAC(10)='PT21'
  1893. TABFAC(11)='PH21'
  1894. TABFAC(12)='PB21'
  1895. TABFAC(13)='PT22'
  1896. TABFAC(14)='PH22'
  1897. TABFAC(15)='PB22'
  1898. TABFAC(16)='RHO '
  1899. TABFAC(17)='ALPH'
  1900.  
  1901. ELSEIF(MELE.GE.178.AND.MELE.LE.182)THEN
  1902. *
  1903. JGOBL=17
  1904. TABOBL(1)='YOUN'
  1905. TABOBL(2)='NU '
  1906. TABOBL(3)='COP1'
  1907. TABOBL(4)='COP2'
  1908. TABOBL(5)='COP3'
  1909. TABOBL(6)='CPP1'
  1910. TABOBL(7)='CPP2'
  1911. TABOBL(8)='CPP3'
  1912. TABOBL(9)='KK11'
  1913. TABOBL(10)='KK12'
  1914. TABOBL(11)='KK13'
  1915. TABOBL(12)='KK21'
  1916. TABOBL(13)='KK22'
  1917. TABOBL(14)='KK23'
  1918. TABOBL(15)='KK31'
  1919. TABOBL(16)='KK32'
  1920. TABOBL(17)='KK33'
  1921. *
  1922. IF(IFOUR.EQ.-2) THEN
  1923. JGFAC=15
  1924. TABFAC(15)='DIM3'
  1925. ELSE
  1926. JGFAC=14
  1927. ENDIF
  1928. TABFAC(1)='RHOF'
  1929. TABFAC(2)='ALPF'
  1930. TABFAC(3)='ALPM'
  1931. TABFAC(4)='PK11'
  1932. TABFAC(5)='PK12'
  1933. TABFAC(6)='PK13'
  1934. TABFAC(7)='PK21'
  1935. TABFAC(8)='PK22'
  1936. TABFAC(9)='PK23'
  1937. TABFAC(10)='PK31'
  1938. TABFAC(11)='PK32'
  1939. TABFAC(12)='PK33'
  1940. TABFAC(13)='RHO '
  1941. TABFAC(14)='ALPH'
  1942.  
  1943. ELSEIF(MELE.GE.188.AND.MELE.LE.190)THEN
  1944. *
  1945. * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D)
  1946. *
  1947. JGOBL=17
  1948. TABOBL(1)='KS '
  1949. TABOBL(2)='KN '
  1950. TABOBL(3)='COP1'
  1951. TABOBL(4)='COP2'
  1952. TABOBL(5)='COP3'
  1953. TABOBL(6)='CPP1'
  1954. TABOBL(7)='CPP2'
  1955. TABOBL(8)='CPP3'
  1956. TABOBL(9)='KK11'
  1957. TABOBL(10)='KK12'
  1958. TABOBL(11)='KK13'
  1959. TABOBL(12)='KK21'
  1960. TABOBL(13)='KK22'
  1961. TABOBL(14)='KK23'
  1962. TABOBL(15)='KK31'
  1963. TABOBL(16)='KK32'
  1964. TABOBL(17)='KK33'
  1965. *
  1966. IF(IFOUR.EQ.-2) THEN
  1967. JGFAC=33
  1968. TABFAC(33)='DIM3'
  1969. ELSE
  1970. JGFAC=32
  1971. ENDIF
  1972. TABFAC(1)='RHOF'
  1973. TABFAC(2)='ALPF'
  1974. TABFAC(3)='ALPM'
  1975. TABFAC(4)='PT11'
  1976. TABFAC(5)='PH11'
  1977. TABFAC(6)='PB11'
  1978. TABFAC(7)='PT12'
  1979. TABFAC(8)='PH12'
  1980. TABFAC(9)='PB12'
  1981. TABFAC(10)='PT13'
  1982. TABFAC(11)='PH13'
  1983. TABFAC(12)='PB13'
  1984. TABFAC(13)='PT21'
  1985. TABFAC(14)='PH21'
  1986. TABFAC(15)='PB21'
  1987. TABFAC(16)='PT22'
  1988. TABFAC(17)='PH22'
  1989. TABFAC(18)='PB22'
  1990. TABFAC(19)='PT23'
  1991. TABFAC(20)='PH23'
  1992. TABFAC(21)='PB23'
  1993. TABFAC(22)='PT31'
  1994. TABFAC(23)='PH31'
  1995. TABFAC(24)='PB31'
  1996. TABFAC(25)='PT32'
  1997. TABFAC(26)='PH32'
  1998. TABFAC(27)='PB32'
  1999. TABFAC(28)='PT33'
  2000. TABFAC(29)='PH33'
  2001. TABFAC(30)='PB33'
  2002. TABFAC(31)='RHO '
  2003. TABFAC(32)='ALPH'
  2004.  
  2005. ENDIF
  2006. *
  2007. IF (INMAT.EQ.0) THEN
  2008. ** IRET = 0
  2009. GOTO 9999
  2010. ENDIF
  2011. *
  2012. 40 CONTINUE
  2013. IF (NMAT.GE.INMAT) THEN
  2014. CALL MODNLI(MOMODL,NMOD)
  2015. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  2016. IF (IPLAC.EQ.1) THEN
  2017. INMAT=INMAT+1
  2018. CALL MODPLA(MOMODL,NMOD)
  2019. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  2020. IF (IPLAC.EQ.0) THEN
  2021. * ISOTROPE
  2022. IPLAC=1
  2023. * ELSE
  2024. * INMAT=INMAT+1
  2025. ENDIF
  2026. CALL IDPLAS(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2027. IF (IRET.EQ.0) GOTO 9999
  2028. ELSEIF (IPLAC.EQ.2) THEN
  2029. INMAT=INMAT+1
  2030. CALL MODFLU(MOMODL,NMOD)
  2031. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  2032. IF (IPLAC.EQ.0) THEN
  2033. * NORTON
  2034. IPLAC=1
  2035. * ELSE
  2036. * INMAT=INMAT+1
  2037. ENDIF
  2038. CALL IDFLUA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2039. IF (IRET.EQ.0) GOTO 9999
  2040. ELSEIF (IPLAC.EQ.3) THEN
  2041. INMAT=INMAT+1
  2042. CALL MODVIS(MOMODL,NMOD)
  2043. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  2044. IF (IPLAC.EQ.0) THEN
  2045. * ONERA
  2046. IPLAC=2
  2047. * ELSE
  2048. * INMAT=INMAT+1
  2049. ENDIF
  2050. CALL IDVISC(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2051. IF (IRET.EQ.0) GOTO 9999
  2052. ELSEIF (IPLAC.EQ.4) THEN
  2053. INMAT=INMAT+1
  2054. CALL MODEND(MOMODL,NMOD)
  2055. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT))
  2056. IF (IPLAC.EQ.0) THEN
  2057. * MAZARS
  2058. IPLAC=1
  2059. * ELSE
  2060. * INMAT=INMAT+1
  2061. ENDIF
  2062. CALL IDENDO(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2063. IF (IRET.EQ.0) GOTO 9999
  2064. ELSE
  2065. * GOTO 9999
  2066. ENDIF
  2067. *
  2068. * En cas de creation de materiaux combinant plusieurs materiaux
  2069. * deja existant Ex ELASTIQUE ISOTROPE PLASTIQUE PARFAIT FLUAGE N
  2070. * GOTO 40
  2071. *
  2072. * GOTO 9999
  2073. ENDIF
  2074. GOTO 9999
  2075. ENDIF
  2076.  
  2077. *--------------------------------------------------------------------
  2078. * CAS DE LA FORMULATION CONTACT
  2079. *--------------------------------------------------------------------
  2080. CALL PLACE(FORMOD,NFOR,ICONT,'CONTACT')
  2081. IF (ICONT.NE.0) THEN
  2082. CALL MODFRO(MOMODL,NMOD)
  2083. iplla =0
  2084. do iou = 1,NMAT
  2085. CALL PLACE(MOMODL(1),5,IPLAC,MATMOD(iou))
  2086. iplla = max(iplac,iplla)
  2087. enddo
  2088. IF (iplla.EQ.0) THEN
  2089. IRET = 0
  2090. GOTO 9999
  2091. ENDIF
  2092.  
  2093. IF ((IPLLA.EQ.1) .OR. (IPLLA.EQ.2) .OR. (IPLLA.EQ.3)) THEN
  2094. * CONTACT SIMPLE
  2095. * --------------
  2096. INMAT=1
  2097. JGOBL=0
  2098.  
  2099. JGFAC=2
  2100. TABFAC(1)='JEU'
  2101. TABFAC(2)='ADHE'
  2102.  
  2103. ELSE IF (IPLLA .EQ. 4) THEN
  2104. * FROTTEMENT DE COULOMB
  2105. * ---------------------
  2106. INMAT=1
  2107. JGOBL=1
  2108. TABOBL(1)='MU '
  2109.  
  2110. JGFAC=3
  2111. TABFAC(1)='COHE'
  2112. TABFAC(2)='ADHE'
  2113. TABFAC(3)='JEU'
  2114.  
  2115. ELSE IF (IPLLA .EQ. 5) THEN
  2116. * FROTTEMENTS DE CABLES
  2117. * ---------------------
  2118. INMAT=1
  2119. JGOBL=2
  2120. TABOBL(1)='FF '
  2121. TABOBL(2)='PHIF'
  2122.  
  2123. JGFAC=0
  2124.  
  2125. ELSE
  2126. IRET=0
  2127. CALL ERREUR (261)
  2128. RETURN
  2129. ENDIF
  2130.  
  2131. GOTO 9999
  2132. ENDIF
  2133.  
  2134. *--------------------------------------------------------------------
  2135. * CAS DE LA FORMULATION MAGNETODYNAMIQUE
  2136. *--------------------------------------------------------------------
  2137. CALL PLACE(FORMOD,NFOR,ICONV,'MAGNETODYNAMIQUE')
  2138. IF (ICONV.NE.0) THEN
  2139. *
  2140. * FORMULATION EN COQUES
  2141. IF(MFR.EQ.3) THEN
  2142. CALL PLACE(MATMOD,NMAT,ISOT,'ISOTROPE')
  2143. IF(ISOT.NE.0) THEN
  2144. JGOBL=3
  2145.  
  2146. TABOBL(1)='ETA'
  2147. TABOBL(2)='PERM'
  2148. TABOBL(3)='EPAI'
  2149. ELSE
  2150. CALL PLACE(MATMOD,NMAT,IORTH,'ORTHOTROPE')
  2151. IF(IORTH.NE.0) THEN
  2152. JGOBL=4
  2153.  
  2154. TABOBL(1)='ETA1'
  2155. TABOBL(2)='ETA2'
  2156. TABOBL(3)='PERM'
  2157. TABOBL(4)='EPAI'
  2158. ENDIF
  2159. ENDIF
  2160. ENDIF
  2161. *
  2162. GOTO 9999
  2163. ENDIF
  2164.  
  2165. *--------------------------------------------------------------------
  2166. * CAS DE LA FORMULATION FISSURE
  2167. *--------------------------------------------------------------------
  2168. CALL PLACE(FORMOD,NFOR,ICONV,'FISSURE')
  2169. IF (ICONV.NE.0) THEN
  2170. *
  2171. * si POISEU_BLASIUS ou POISEU_COLEBROOK ou par defaut
  2172. JGOBL=1
  2173.  
  2174. TABOBL(1)='RUGO'
  2175. * si FROTTEMENT1 ou FROTTEMENT2
  2176. CALL PLACE(MATMOD,NMAT,IFT1,'FROTTEMENT1')
  2177. CALL PLACE(MATMOD,NMAT,IFT2,'FROTTEMENT2')
  2178. IF(IFT1.NE.0.OR.IFT2.NE.0) THEN
  2179. JGOBL=7
  2180.  
  2181. TABOBL(2)='REC'
  2182. TABOBL(3)='FK'
  2183. TABOBL(4)='FA'
  2184. TABOBL(5)='FB'
  2185. TABOBL(6)='FC'
  2186. TABOBL(7)='FD'
  2187. ELSE
  2188. * si FROTTEMENT3 ou FROTTEMENT4
  2189. CALL PLACE(MATMOD,NMAT,IFT1,'FROTTEMENT3')
  2190. CALL PLACE(MATMOD,NMAT,IFT2,'FROTTEMENT4')
  2191. IF(IFT1.NE.0.OR.IFT2.NE.0) THEN
  2192. JGOBL=2
  2193.  
  2194. TABOBL(2)='FK'
  2195. ENDIF
  2196. ENDIF
  2197. GOTO 9999
  2198. ENDIF
  2199.  
  2200. *--------------------------------------------------------------------
  2201. * CAS DE LA FORMULATION MELANGE
  2202. *--------------------------------------------------------------------
  2203. CALL PLACE(FORMOD,NFOR,ICONV,'MELANGE')
  2204. IF (ICONV.NE.0) THEN
  2205. CALL MODMEL(MOMODL,NMOD)
  2206. CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(1))
  2207. if (iplac.eq.0) then
  2208. iret = 0
  2209. goto 9999
  2210. endif
  2211. INMAT=1
  2212. *
  2213. * a priori elements massifs ou coques : pas de verif
  2214. *
  2215. IF (IPLAC.NE.3.AND.IPLAC.NE.4) THEN
  2216. JGOBL = 0
  2217. JGFAC = 0
  2218. CALL IDMETA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2219. IF (IRET.EQ.0) GOTO 9999
  2220. * construit les noms de composante en PARALLELE ou en SERIE
  2221. c* ELSEIF (iplac.eq.3.or.iplac.eq.4) THEN
  2222. ELSE
  2223. JGOBL = imodel.ivamod(/1)
  2224.  
  2225. kc1 = 0
  2226. do ic1 = 1,JGOBL
  2227. if (tymode(ic1).eq.'IMODEL') then
  2228. imode2 = ivamod(ic1)
  2229. segact imode2
  2230. lozut = .false.
  2231. if (kc1.ge.1) then
  2232. do kkc1 = 1, kc1
  2233. if (imode2.conmod(17:20).eq.TABOBL(kkc1)) then
  2234. lozut = .true.
  2235. endif
  2236. enddo
  2237. endif
  2238. if (.not.lozut) then
  2239. kc1 = kc1 + 1
  2240. TABOBL(kc1) = imode2.conmod(17:20)
  2241. endif
  2242. endif
  2243. enddo
  2244. JGOBL = kc1
  2245.  
  2246. ENDIF
  2247. GOTO 9999
  2248. ENDIF
  2249.  
  2250. *--------------------------------------------------------------------
  2251. * CAS DE LA FORMULATION LIAISON
  2252. *--------------------------------------------------------------------
  2253. CALL PLACE(FORMOD,NFOR,ICONV,'LIAISON')
  2254. IF (ICONV.NE.0) THEN
  2255. iplac = imatee
  2256. if (iplac.eq.0) then
  2257. iret = 0
  2258. goto 9999
  2259. endif
  2260. *
  2261. JGOBL = 0
  2262. JGFAC = 0
  2263.  
  2264. * 'SORT' facultatif dans tous les cas
  2265. IF (iplac.EQ.1) THEN
  2266. *PO_PL_FL
  2267. JGM0 = JGOBL
  2268. JGOBL = JGM0+7
  2269. TABOBL(JGM0 + 1) ='NORM'
  2270. TABOBL(JGM0 + 2) ='INER'
  2271. TABOBL(JGM0 + 3) ='CONV'
  2272. TABOBL(JGM0 + 4) ='VISC'
  2273. TABOBL(JGM0 + 5) ='PELO'
  2274. TABOBL(JGM0 + 6) ='PRAP'
  2275. TABOBL(JGM0 + 7) ='JFLU'
  2276.  
  2277. ELSEIF (iplac.eq.2) then
  2278. *PO_PL_FR
  2279. JGM0 = JGOBL
  2280. JGOBL = JGM0+7
  2281. TABOBL(JGM0 + 1) ='NORM'
  2282. TABOBL(JGM0 + 2) ='RAID'
  2283. TABOBL(JGM0 + 3) ='JEU'
  2284. TABOBL(JGM0 + 4) ='GLIS'
  2285. TABOBL(JGM0 + 5) ='ADHE'
  2286. TABOBL(JGM0 + 6) ='RTAN'
  2287. TABOBL(JGM0 + 7) ='ATAN'
  2288.  
  2289. JGM0 = JGFAC
  2290. JGFAC = JGM0 +2
  2291. TABFAC(JGM0+1) = 'AMOR'
  2292. TABFAC(JGM0+2) = 'LOIC'
  2293.  
  2294. ELSEIF (iplac.eq.3) then
  2295. *PO_PL
  2296. JGM0 = JGOBL
  2297. JGOBL= JGM0+3
  2298. TABOBL(JGM0 + 1) ='NORM'
  2299. TABOBL(JGM0 + 2) ='RAID'
  2300. TABOBL(JGM0 + 3) ='JEU'
  2301.  
  2302. JGM0 = JGFAC
  2303. JGFAC = JGM0+4
  2304. TABFAC(JGM0+1) = 'LOIC'
  2305. TABFAC(JGM0+2) = 'PERM'
  2306. TABFAC(JGM0 + 3) ='SPLA'
  2307. TABFAC(JGM0 + 4) ='AMOR'
  2308.  
  2309. ELSEIF (iplac.eq.4) then
  2310. *PO_PO_FR
  2311. JGM0 = JGOBL
  2312. JGOBL= JGM0 + 8
  2313. TABOBL(JGM0 + 1) ='NORM'
  2314. TABOBL(JGM0 + 2) ='RAID'
  2315. TABOBL(JGM0 + 3) ='JEU'
  2316. TABOBL(JGM0 + 4) ='POIB'
  2317. TABOBL(JGM0 + 5) ='ADHE'
  2318. TABOBL(JGM0 + 6) ='RTAN'
  2319. TABOBL(JGM0 + 7) ='ATAN'
  2320. TABOBL(JGM0 + 8) ='GLIS'
  2321.  
  2322. JGM0 = JGFAC
  2323. JGFAC = JGM0 + 3
  2324. TABFAC(JGM0+1) = 'AMOR'
  2325. TABFAC(JGM0+2) = 'LOIC'
  2326. TABFAC(JGM0+3) = 'MODE'
  2327.  
  2328. ELSEIF (iplac.eq.5) then
  2329. *PO_PO_DP
  2330. JGM0 = JGOBL
  2331. JGOBL= JGM0 + 6
  2332. TABOBL(JGM0 + 1) ='NORM'
  2333. TABOBL(JGM0 + 2) ='ECRO'
  2334. TABOBL(JGM0 + 3) ='JEU'
  2335. TABOBL(JGM0 + 4) ='POIB'
  2336. TABOBL(JGM0 + 5) ='PERM'
  2337. TABOBL(JGM0 + 6) ='LOIC'
  2338.  
  2339. JGM0 = JGFAC
  2340. JGFAC = JGM0 + 1
  2341. TABFAC(JGM0+1) = 'AMOR'
  2342.  
  2343. ELSEIF (iplac.eq.6) then
  2344. *PO_PO_RP
  2345. JGM0 = JGOBL
  2346. JGOBL= JGM0 + 6
  2347. TABOBL(JGM0 + 1) ='AXRO'
  2348. TABOBL(JGM0 + 2) ='ECRO'
  2349. TABOBL(JGM0 + 3) ='JEU'
  2350. TABOBL(JGM0 + 4) ='POIB'
  2351. TABOBL(JGM0 + 5) ='PERM'
  2352. TABOBL(JGM0 + 6) ='LOIC'
  2353.  
  2354. JGM0 = JGFAC
  2355. JGFAC = JGM0 + 2
  2356. TABFAC(JGM0+1) = 'AMOR'
  2357. TABFAC(JGM0+2) = 'ELAS'
  2358.  
  2359. ELSEIF (iplac.eq.7) then
  2360. *PO_PO
  2361. JGM0 = JGOBL
  2362. JGOBL= JGM0 + 5
  2363. TABOBL(JGM0 + 1) ='NORM'
  2364. TABOBL(JGM0 + 2) ='RAID'
  2365. TABOBL(JGM0 + 3) ='JEU'
  2366. TABOBL(JGM0 + 4) ='POIB'
  2367. TABOBL(JGM0 + 5) ='PERM'
  2368.  
  2369. JGM0 = JGFAC
  2370. JGFAC = JGM0 + 2
  2371. TABFAC(JGM0+1) = 'AMOR'
  2372. TABFAC(JGM0+2) = 'LOIC'
  2373.  
  2374. ELSEIF (iplac.eq.8) then
  2375. *PO_CE_MO
  2376. JGM0 = JGOBL
  2377. JGOBL= JGM0 + 8
  2378. TABOBL(JGM0 + 1) ='NORM'
  2379. TABOBL(JGM0 + 2) ='RAID'
  2380. TABOBL(JGM0 + 3) ='PCER'
  2381. TABOBL(JGM0 + 4) ='RAYO'
  2382. TABOBL(JGM0 + 5) ='GLIS'
  2383. TABOBL(JGM0 + 6) ='ADHE'
  2384. TABOBL(JGM0 + 7) ='RTAN'
  2385. TABOBL(JGM0 + 8) ='ATAN'
  2386.  
  2387. JGM0 = JGFAC
  2388. JGFAC= JGM0 + 2
  2389. TABFAC(JGM0+1) = 'CINT'
  2390. TABFAC(JGM0+2) = 'AMOR'
  2391.  
  2392. ELSEIF (iplac.eq.9) then
  2393. *PO_CE_FR
  2394. JGM0 = JGOBL
  2395. JGOBL= JGM0 + 8
  2396. TABOBL(JGM0 + 1) ='NORM'
  2397. TABOBL(JGM0 + 2) ='RAID'
  2398. TABOBL(JGM0 + 3) ='EXCE'
  2399. TABOBL(JGM0 + 4) ='RAYO'
  2400. TABOBL(JGM0 + 5) ='GLIS'
  2401. TABOBL(JGM0 + 6) ='ADHE'
  2402. TABOBL(JGM0 + 7) ='RTAN'
  2403. TABOBL(JGM0 + 8) ='ATAN'
  2404.  
  2405. JGM0 = JGFAC
  2406. JGFAC = JGM0 + 2
  2407. TABFAC(JGM0+1) = 'CINT'
  2408. TABFAC(JGM0+2) = 'AMOR'
  2409.  
  2410. ELSEIF (iplac.eq.10) then
  2411. *PO_CE
  2412. JGM0 = JGOBL
  2413. JGOBL= JGM0 + 4
  2414. TABOBL(JGM0 + 1) ='NORM'
  2415. TABOBL(JGM0 + 2) ='RAID'
  2416. TABOBL(JGM0 + 3) ='EXCE'
  2417. TABOBL(JGM0 + 4) ='RAYO'
  2418.  
  2419. JGM0 = JGFAC
  2420. JGFAC = JGM0 + 1
  2421. TABFAC(JGM0+1) = 'AMOR'
  2422.  
  2423. ELSEIF (iplac.eq.11) then
  2424. *CE_PL_FR
  2425. JGM0 = JGOBL
  2426. JGOBL= JGM0 + 8
  2427. TABOBL(JGM0 + 1) ='NORM'
  2428. TABOBL(JGM0 + 2) ='RAID'
  2429. TABOBL(JGM0 + 3) ='JEU'
  2430. TABOBL(JGM0 + 4) ='RAYS'
  2431. TABOBL(JGM0 + 5) ='GLIS'
  2432. TABOBL(JGM0 + 6) ='ADHE'
  2433. TABOBL(JGM0 + 7) ='RTAN'
  2434. TABOBL(JGM0 + 8) ='ATAN'
  2435.  
  2436. JGM0 = JGFAC
  2437. JGFAC = JGM0+1
  2438. TABFAC(JGM0+1) = 'AMOR'
  2439.  
  2440. ELSEIF (iplac.eq.12) then
  2441. *CE_CE_FR
  2442. JGM0 = JGOBL
  2443. JGOBL= JGM0 + 9
  2444. TABOBL(JGM0 + 1) ='NORM'
  2445. TABOBL(JGM0 + 2) ='RAID'
  2446. TABOBL(JGM0 + 3) ='EXCE'
  2447. TABOBL(JGM0 + 4) ='RAYS'
  2448. TABOBL(JGM0 + 5) ='GLIS'
  2449. TABOBL(JGM0 + 6) ='ADHE'
  2450. TABOBL(JGM0 + 7) ='RTAN'
  2451. TABOBL(JGM0 + 8) ='ATAN'
  2452. TABOBL(JGM0 + 9) ='RAYB'
  2453.  
  2454. JGM0 = JGFAC
  2455. JGFAC = JGM0 + 2
  2456. TABFAC(JGM0+1) = 'AMOR'
  2457. TABFAC(JGM0+2) = 'CINT'
  2458.  
  2459. ELSEIF (iplac.eq.13.or.iplac.eq.14) then
  2460. *PR_PR_IN ou PR_PR_EX
  2461. JGM0 = JGOBL
  2462. JGOBL= JGM0 + 5
  2463. TABOBL(JGM0 + 1) ='NORM'
  2464. TABOBL(JGM0 + 2) ='RAID'
  2465. TABOBL(JGM0 + 3) ='PFIX'
  2466. TABOBL(JGM0 + 4) ='PMOB'
  2467. TABOBL(JGM0 + 5) ='ERAI'
  2468.  
  2469. ELSEIF (iplac.eq.15) then
  2470. *LI_LI_FR
  2471. JGM0 = JGOBL
  2472. JGOBL= JGM0 + 9
  2473. TABOBL(JGM0 + 1) ='NORM'
  2474. TABOBL(JGM0 + 2) ='LIMA'
  2475. TABOBL(JGM0 + 3) ='LIES'
  2476. TABOBL(JGM0 + 4) ='RAID'
  2477. TABOBL(JGM0 + 5) ='GLIS'
  2478. TABOBL(JGM0 + 6) ='ADHE'
  2479. TABOBL(JGM0 + 7) ='RTAN'
  2480. TABOBL(JGM0 + 8) ='ATAN'
  2481. TABOBL(JGM0 + 9) ='JEU'
  2482.  
  2483. JGM0 = JGFAC
  2484. JGFAC = JGM0 + 3
  2485. TABFAC(JGM0+1) = 'AMOR'
  2486. TABFAC(JGM0+2) = 'RECH'
  2487. TABFAC(JGM0+3) = 'SYME'
  2488.  
  2489. ELSEIF (iplac.eq.16) then
  2490. *LI_CE_FR
  2491. JGM0 = JGOBL
  2492. JGOBL= JGM0 + 8
  2493. TABOBL(JGM0 + 1) ='NORM'
  2494. TABOBL(JGM0 + 2) ='LIMA'
  2495. TABOBL(JGM0 + 3) ='LIES'
  2496. TABOBL(JGM0 + 4) ='RAID'
  2497. TABOBL(JGM0 + 5) ='GLIS'
  2498. TABOBL(JGM0 + 6) ='ADHE'
  2499. TABOBL(JGM0 + 7) ='RTAN'
  2500. TABOBL(JGM0 + 8) ='ATAN'
  2501.  
  2502. JGM0 = JGFAC
  2503. JGFAC = JGM0 + 5
  2504. TABFAC(JGM0+1) = 'AMOR'
  2505. TABFAC(JGM0+2) = 'RECH'
  2506. TABFAC(JGM0+3) = 'RAYO'
  2507. TABFAC(JGM0+4) = 'ACTN'
  2508. TABFAC(JGM0+5) = 'INVE'
  2509.  
  2510. ELSEIF (iplac.eq.17) then
  2511. *PA_FL_RO
  2512. JGM0 = JGOBL
  2513. JGOBL= JGM0+10
  2514. TABOBL(JGM0 + 1) ='LONG'
  2515. TABOBL(JGM0 + 2) ='RAYO'
  2516. TABOBL(JGM0 + 3) ='VISC'
  2517. TABOBL(JGM0 + 4) ='RHOF'
  2518. TABOBL(JGM0 + 5) ='PADM'
  2519. TABOBL(JGM0 + 6) ='VROT'
  2520. TABOBL(JGM0 + 7) ='EPSI'
  2521. TABOBL(JGM0 + 8) ='PHII'
  2522. TABOBL(JGM0 + 9) ='AFFI'
  2523. TABOBL(JGM0 + 10)='TLOB'
  2524.  
  2525. JGM0 = JGFAC
  2526. JGFAC = JGM0 + 1
  2527. TABFAC(JGM0+1) = 'AMOR'
  2528.  
  2529. ELSEIF (iplac.eq.23) then
  2530. *NEWMARK MODAL
  2531. JGM0 = JGOBL
  2532. JGOBL= JGM0+1
  2533. TABOBL(JGM0 + 1) ='JEU'
  2534.  
  2535. JGM0 = JGFAC
  2536. JGFAC = JGM0 + 3
  2537. TABFAC(JGM0+1) = 'EXCE'
  2538. TABFAC(JGM0+2) = 'FROT'
  2539. TABFAC(JGM0+3) = 'MOFR'
  2540. ENDIF
  2541. * 'SORT' facultatif dans tous les cas
  2542. JGM0 = JGFAC
  2543. JGFAC= JGM0+1
  2544. TABFAC(JGM0+1) = 'SORT'
  2545. GOTO 9999
  2546. ENDIF
  2547.  
  2548. *--------------------------------------------------------------------
  2549. * CAS DE LA FORMULATION ELECTROSTATIQUE
  2550. *--------------------------------------------------------------------
  2551. CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE')
  2552. IF (IELEC.NE.0) THEN
  2553. C -- Permittivite isotrope
  2554. IF (IMATEE.EQ.1) THEN
  2555. C* IF (CMATEE.EQ.'ISOTROPE') THEN
  2556. C* IF (MATMOD(1).EQ.'ISOTROPE ') THEN
  2557. JGOBL = 1
  2558. TABOBL(1)='PEL '
  2559. C -- Permittivite orthotrope
  2560. ELSEIF (IMATEE.EQ.2) THEN
  2561. C* ELSEIF (CMATEE.EQ.'ORTHOTRO') THEN
  2562. C* ELSEIF (MATMOD(1).EQ.'ORTHOTROPE ') THEN
  2563. C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE
  2564. IF (IDIM.EQ.2) THEN
  2565. IF (IFOMOD.NE.1) THEN
  2566. JGOBL = 4
  2567. TABOBL(1) = 'PE1 '
  2568. TABOBL(2) = 'PE2 '
  2569. TABOBL(3) = 'V1X '
  2570. TABOBL(4) = 'V1Y '
  2571.  
  2572. C ---- Elements massifs bidimensionnels FOURIER
  2573. ELSE
  2574. JGOBL = 5
  2575. TABOBL(1) = 'PE1 '
  2576. TABOBL(2) = 'PE2 '
  2577. TABOBL(3) = 'PE3 '
  2578. TABOBL(4) = 'V1X '
  2579. TABOBL(5) = 'V1Y '
  2580. ENDIF
  2581. C ---- Elements massifs TRIDimensionnels
  2582. ELSEIF (IDIM.EQ.3) THEN
  2583. JGOBL = 9
  2584. TABOBL(1) = 'PE1 '
  2585. TABOBL(2) = 'PE2 '
  2586. TABOBL(3) = 'PE3 '
  2587. TABOBL(4) = 'V1X '
  2588. TABOBL(5) = 'V1Y '
  2589. TABOBL(6) = 'V1Z '
  2590. TABOBL(7) = 'V2X '
  2591. TABOBL(8) = 'V2Y '
  2592. TABOBL(9) = 'V2Z '
  2593. ENDIF
  2594.  
  2595. C -- Permittivite anisotrope
  2596. ELSEIF (IMATEE.EQ.3) THEN
  2597. C* ELSEIF (CMATEE.EQ.'ANISOTRO') THEN
  2598. C* ELSEIF (MATMOD(1).EQ.'ANISOTROPE ') THEN
  2599. C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE
  2600. IF (IDIM.EQ.2) THEN
  2601. IF (IFOMOD.NE.1) THEN
  2602. JGOBL = 5
  2603. TABOBL(1) = 'PE11 '
  2604. TABOBL(2) = 'PE22 '
  2605. TABOBL(3) = 'PE21 '
  2606. TABOBL(4) = 'V1X '
  2607. TABOBL(5) = 'V1Y '
  2608.  
  2609. C ---- Elements massifs bidimensionnels FOURIER
  2610. ELSE
  2611. JGOBL = 6
  2612. TABOBL(1) = 'PE11 '
  2613. TABOBL(2) = 'PE22 '
  2614. TABOBL(3) = 'PE21 '
  2615. TABOBL(4) = 'PE33 '
  2616. TABOBL(5) = 'V1X '
  2617. TABOBL(6) = 'V1Y '
  2618. ENDIF
  2619.  
  2620. C ---- Elements massifs TRIDimensionnels
  2621. ELSEIF (IDIM.EQ.3) THEN
  2622. JGOBL = 12
  2623. TABOBL( 1) = 'PE11 '
  2624. TABOBL( 2) = 'PE22 '
  2625. TABOBL( 3) = 'PE33 '
  2626. TABOBL( 4) = 'PE21 '
  2627. TABOBL( 5) = 'PE31 '
  2628. TABOBL( 6) = 'PE32 '
  2629. TABOBL( 7) = 'V1X '
  2630. TABOBL( 8) = 'V1Y '
  2631. TABOBL( 9) = 'V1Z '
  2632. TABOBL(10) = 'V2X '
  2633. TABOBL(11) = 'V2Y '
  2634. TABOBL(12) = 'V2Z '
  2635. ENDIF
  2636.  
  2637. ELSE
  2638. IRET = 0
  2639. CALL ERREUR(5)
  2640. ENDIF
  2641. GOTO 9999
  2642. ENDIF
  2643.  
  2644. *-----------------------------------------------------------------------
  2645. * CAS DE LA FORMULATION 'DIFFUSION'
  2646. *-----------------------------------------------------------------------
  2647. CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
  2648. IF (IDIFF.NE.0) THEN
  2649. IMATE = IMATEE
  2650. IPLAC = INATUU
  2651.  
  2652. C -- Diffusion lineaire (composantes obligatoires)
  2653. CALL IDDILI(IMATE,0, MOOBL,NBROBL,NBRFAC)
  2654. IF (MOOBL.EQ.0) GOTO 9999
  2655.  
  2656. JGM0 =JGOBL
  2657. JGOBL=JGOBL + NBROBL
  2658. DO IC=1,NBROBL
  2659. TABOBL(JGM0 + IC)=MOOBL.MOTS(IC)
  2660. ENDDO
  2661. SEGSUP,MOOBL
  2662.  
  2663. C -- Ajout des Modeles non lineaires de diffusion
  2664. CALL IDDIFF(IMATE,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET)
  2665. GOTO 9999
  2666. ENDIF
  2667.  
  2668. *-----------------------------------------------------------------------
  2669. * CAS DE LA FORMULATION 'CHARGEMENT'
  2670. *-----------------------------------------------------------------------
  2671. CALL PLACE(FORMOD,NFOR,ICHAR,'CHARGEMENT')
  2672. IF (ICHAR.NE.0) THEN
  2673. IPLAC = IMATEE
  2674. IF (IPLAC.EQ.1) THEN
  2675. C RAJOUTER DIFFERENTIATION EN FONCIONS DE LA FORMULATION MASSIF -> P
  2676. C COQUE PINF PSUP
  2677. JGOBL=1
  2678. TABOBL(1)='PR '
  2679. ELSE
  2680. IRET = 0
  2681. CALL ERREUR(5)
  2682. ENDIF
  2683. GOTO 9999
  2684. ENDIF
  2685.  
  2686. *--------------------------------------------------------------------
  2687. 9999 CONTINUE
  2688.  
  2689. IF(IMECA.GT.0 .OR. IPORE.GT.0)THEN
  2690. C CB215821 : Ajout de TREF et TALP à la fin des compostantes facultatives
  2691. C pour les FORMULATION MECANIQUE, POREUX
  2692. C Pour ne pas casser l'ordre dans COMP (com2/coml6/comval/comara/...)
  2693. JGFAC=JGFAC+2
  2694. TABFAC(JGFAC-1) ='TREF'
  2695. TABFAC(JGFAC) ='TALP'
  2696. ENDIF
  2697.  
  2698. C Erreur si JGOBL ou JGFAC sont superieurs a ITA
  2699. C (Passage en FORTRAN 77 car la compilation depasse la memoire sur
  2700. C Windows-32bits)
  2701. IF ((JGOBL .GT. ITA) .OR. (JGFAC .GT. ITA)) THEN
  2702. IRET = 0
  2703. CALL ERREUR(5)
  2704. RETURN
  2705. ENDIF
  2706.  
  2707. NBROBL = JGOBL
  2708. NBRFAC = JGFAC
  2709. NOMID = 0
  2710.  
  2711. * SI PROBLEME (IRET = 0), ON SORT AVEC IPNOMC A 0
  2712. *
  2713. IF (IRET.NE.0) THEN
  2714. SEGINI,NOMID
  2715. DO 100 IO = 1,NBROBL
  2716. NOMID.LESOBL(IO) = TABOBL(IO)
  2717. 100 CONTINUE
  2718.  
  2719. DO 110 IO=1,NBRFAC
  2720. NOMID.LESFAC(IO) = TABFAC(IO)
  2721. 110 CONTINUE
  2722. ENDIF
  2723.  
  2724. IPNOMC = NOMID
  2725.  
  2726. END
  2727.  
  2728.  
  2729.  
  2730.  
  2731.  

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