Télécharger carmat.eso

Retour à la liste

Numérotation des lignes :

carmat
  1. C CARMAT SOURCE BP208322 16/11/18 21:15:25 9177
  2. SUBROUTINE CARMAT(IPMODE,IPCHE1,IPMAIL,MFR,MELE,CMATE,
  3. 1 ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET)
  4. C_______________________________________________________________________
  5. C
  6. C Entrees:
  7. C ________
  8. C
  9. C IPMODE Pointeur sur un IMODEL
  10. C IPCHE1 Pointeur sur un MCHAML de caracteristiques
  11. C IPMAIL Pointeur sur un maillage elementaire
  12. C MFR Formulation de l element fini
  13. C MELE Numero de l element fini
  14. C CMATE Nom du materiau
  15. C ISUP5 Critere d existence des caracteristiques
  16. C INFOS Tableau d infos
  17. C CONM Nom du maillage elementaire
  18. C
  19. C Sorties:
  20. C ________
  21. C
  22. C IMAT = Pointeur sur un tableau de MELVAL de MATERIAU
  23. C ICAR = Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
  24. C NUMAT = Nombre des composantes de materiau
  25. C NUCAR = Nombre des composantes des caract. geometriques
  26. C IRET 1 si tout OK 0 sinon
  27. C
  28. C_______________________________________________________________________
  29. C
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8 (A-H,O-Z)
  32.  
  33. -INC CCHAMP
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37.  
  38. -INC SMCHAML
  39. -INC SMMODEL
  40. -INC CCGEOME
  41.  
  42. SEGMENT NOTYPE
  43. CHARACTER*16 TYPE(NBTYPE)
  44. ENDSEGMENT
  45. *
  46. SEGMENT MPTVAL
  47. INTEGER IPOS(NS) ,NSOF(NS)
  48. INTEGER IVAL(NCOSOU)
  49. CHARACTER*16 TYVAL(NCOSOU)
  50. ENDSEGMENT
  51. *
  52. CHARACTER*8 CMATE
  53. CHARACTER*(NCONCH) CONM
  54. PARAMETER (NINF=3)
  55. INTEGER INFOS(NINF)
  56. LOGICAL lsupma
  57. C
  58. IRET=1
  59. IMAT=0
  60. ICAR=0
  61. MOCARA=0
  62. MOMATR=0
  63. NUMAT=0
  64. NUCAR=0
  65. NBTYPE=0
  66. IPPORE=0
  67. IF(MFR.EQ.33) IPPORE= NBNNE(NUMGEO(MELE))
  68. C
  69. C TRAITEMENT DU MODELE
  70. C
  71. IMODEL=IPMODE
  72. lsupma=.true.
  73. *
  74. * TRAITEMENT DES CHAMPS DE MATERIAU
  75. *
  76. IF (FORMOD(1).EQ.'MECANIQUE') THEN
  77. IF (CMATE.EQ.'ISOTROPE') THEN
  78. NBROBL=2
  79. NBRFAC=0
  80. SEGINI NOMID
  81. MOMATR=NOMID
  82. IF (MFR.EQ.35) THEN
  83. LESOBL(1)='KS '
  84. LESOBL(2)='KN '
  85. *
  86. ELSE IF(MFR.EQ.53)THEN
  87. NBROBL=1
  88. SEGADJ,NOMID
  89. LESOBL(1)='KS '
  90. *
  91. ELSE
  92. LESOBL(1)='YOUN'
  93. LESOBL(2)='NU '
  94. ENDIF
  95. NMATR=NBROBL
  96. NMATF=NBRFAC
  97. ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  98. IF (MFR.EQ.3) THEN
  99. * COQUES MINCES
  100. NBROBL=6
  101. NBRFAC=0
  102. SEGINI NOMID
  103. MOMATR=NOMID
  104. LESOBL(1)='YG1 '
  105. LESOBL(2)='YG2 '
  106. LESOBL(3)='NU12'
  107. LESOBL(4)='G12 '
  108. LESOBL(5)='V1X '
  109. LESOBL(6)='V1Y '
  110. ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
  111. * COQUES AVEC CISAILLEMENT TRANSVERSE
  112. NBROBL=8
  113. NBRFAC=0
  114. SEGINI NOMID
  115. MOMATR=NOMID
  116. LESOBL(1)='YG1 '
  117. LESOBL(2)='YG2 '
  118. LESOBL(3)='NU12'
  119. LESOBL(4)='G12 '
  120. LESOBL(5)='G23 '
  121. LESOBL(6)='G13 '
  122. LESOBL(7)='V1X '
  123. LESOBL(8)='V1Y '
  124. ELSE IF (MFR.EQ.1) THEN
  125. * ELEMENTS MASSIFS
  126. IF(IDIM.EQ.3)THEN
  127. * ELEMENTS 3D
  128. NBROBL=15
  129. NBRFAC=0
  130. SEGINI NOMID
  131. MOMATR=NOMID
  132. LESOBL(1)='YG1 '
  133. LESOBL(2)='YG2 '
  134. LESOBL(3)='YG3 '
  135. LESOBL(4)='NU12'
  136. LESOBL(5)='NU23'
  137. LESOBL(6)='NU13'
  138. LESOBL(7)='G12 '
  139. LESOBL(8)='G23 '
  140. LESOBL(9)='G13 '
  141. LESOBL(10)='V1X '
  142. LESOBL(11)='V1Y '
  143. LESOBL(12)='V1Z '
  144. LESOBL(13)='V2X '
  145. LESOBL(14)='V2Y '
  146. LESOBL(15)='V2Z '
  147. ELSE IF (IDIM.EQ.2) THEN
  148. IF(IFOUR.EQ.-2)THEN
  149. * CONTRAINTE PLANE
  150. NBROBL=6
  151. NBRFAC=0
  152. SEGINI NOMID
  153. MOMATR=NOMID
  154. LESOBL(1)='YG1 '
  155. LESOBL(2)='YG2 '
  156. LESOBL(3)='NU12'
  157. LESOBL(4)='G12 '
  158. LESOBL(5)='V1X '
  159. LESOBL(6)='V1Y '
  160. ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  161. * DEFORMATION PLANE ,AXISYMETRIE
  162. NBROBL=9
  163. NBRFAC=0
  164. SEGINI NOMID
  165. MOMATR=NOMID
  166. LESOBL(1)='YG1 '
  167. LESOBL(2)='YG2 '
  168. LESOBL(3)='YG3 '
  169. LESOBL(4)='NU12'
  170. LESOBL(5)='NU23'
  171. LESOBL(6)='NU13'
  172. LESOBL(7)='G12 '
  173. LESOBL(8)='V1X '
  174. LESOBL(9)='V1Y '
  175. ELSE IF (IFOUR.EQ.1) THEN
  176. * AXISYMETRIE DE FOURIER
  177. NBROBL=11
  178. NBRFAC=0
  179. SEGINI NOMID
  180. MOMATR=NOMID
  181. LESOBL(1)='YG1 '
  182. LESOBL(2)='YG2 '
  183. LESOBL(3)='YG3 '
  184. LESOBL(4)='NU12'
  185. LESOBL(5)='NU23'
  186. LESOBL(6)='NU13'
  187. LESOBL(7)='G12 '
  188. LESOBL(8)='G23 '
  189. LESOBL(9)='G13 '
  190. LESOBL(10)='V1X '
  191. LESOBL(11)='V1Y '
  192. ENDIF
  193. ENDIF
  194. ELSE IF (MFR.EQ.35) THEN
  195. * ELEMENTS JOINTS
  196. IF (IFOUR.EQ.2) THEN
  197. NBROBL=5
  198. NBRFAC=0
  199. SEGINI NOMID
  200. MOMATR=NOMID
  201. LESOBL(1)='KS1 '
  202. LESOBL(2)='KS2 '
  203. LESOBL(3)='KN '
  204. LESOBL(4)='V1X '
  205. LESOBL(5)='V1Y '
  206. ENDIF
  207. ENDIF
  208. NMATR=NBROBL
  209. NMATF=NBRFAC
  210. ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  211. IF(MFR.EQ.1)THEN
  212. * ELEMENTS MASSIFS
  213. IF(IDIM.EQ.3)THEN
  214. * ELEMENTS 3D
  215. IF (IFOUR.EQ.2) THEN
  216. NBROBL=27
  217. NBRFAC=0
  218. SEGINI NOMID
  219. MOMATR=NOMID
  220. LESOBL(1)='D11 '
  221. LESOBL(2)='D21 '
  222. LESOBL(3)='D22 '
  223. LESOBL(4)='D31 '
  224. LESOBL(5)='D32 '
  225. LESOBL(6)='D33 '
  226. LESOBL(7)='D41 '
  227. LESOBL(8)='D42 '
  228. LESOBL(9)='D43 '
  229. LESOBL(10)='D44 '
  230. LESOBL(11)='D51 '
  231. LESOBL(12)='D52 '
  232. LESOBL(13)='D53 '
  233. LESOBL(14)='D54 '
  234. LESOBL(15)='D55 '
  235. LESOBL(16)='D61 '
  236. LESOBL(17)='D62 '
  237. LESOBL(18)='D63 '
  238. LESOBL(19)='D64 '
  239. LESOBL(20)='D65 '
  240. LESOBL(21)='D66 '
  241. LESOBL(22)='V1X '
  242. LESOBL(23)='V1Y '
  243. LESOBL(24)='V1Z '
  244. LESOBL(25)='V2X '
  245. LESOBL(26)='V2Y '
  246. LESOBL(27)='V2Z '
  247. ENDIF
  248. ELSE IF (IDIM.EQ.2) THEN
  249. IF (IFOUR.EQ.-2) THEN
  250. * CONTRAINTE PLANE
  251. NBROBL=8
  252. NBRFAC=0
  253. SEGINI NOMID
  254. MOMATR=NOMID
  255. LESOBL(1)='D11 '
  256. LESOBL(2)='D21 '
  257. LESOBL(3)='D22 '
  258. LESOBL(4)='D41 '
  259. LESOBL(5)='D42 '
  260. LESOBL(6)='D44 '
  261. LESOBL(7)='V1X '
  262. LESOBL(8)='V1Y '
  263. ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  264. * DEFORMATION PLANE ,AXISYMETRIE
  265. NBROBL=12
  266. NBRFAC=0
  267. SEGINI NOMID
  268. MOMATR=NOMID
  269. LESOBL(1)='D11 '
  270. LESOBL(2)='D21 '
  271. LESOBL(3)='D22 '
  272. LESOBL(4)='D31 '
  273. LESOBL(5)='D32 '
  274. LESOBL(6)='D33 '
  275. LESOBL(7)='D41 '
  276. LESOBL(8)='D42 '
  277. LESOBL(9)='D43 '
  278. LESOBL(10)='D44 '
  279. LESOBL(11)='V1X '
  280. LESOBL(12)='V1Y '
  281. ELSE IF (IFOUR.EQ.1) THEN
  282. * AXISYMETRIE DE FOURIER
  283. NBROBL=15
  284. NBRFAC=0
  285. SEGINI NOMID
  286. MOMATR=NOMID
  287. LESOBL(1)='D11 '
  288. LESOBL(2)='D21 '
  289. LESOBL(3)='D22 '
  290. LESOBL(4)='D31 '
  291. LESOBL(5)='D32 '
  292. LESOBL(6)='D33 '
  293. LESOBL(7)='D41 '
  294. LESOBL(8)='D42 '
  295. LESOBL(9)='D43 '
  296. LESOBL(10)='D44 '
  297. LESOBL(11)='D55 '
  298. LESOBL(12)='D65 '
  299. LESOBL(13)='D66 '
  300. LESOBL(14)='V1X '
  301. LESOBL(15)='V1Y '
  302. ENDIF
  303. ENDIF
  304. ENDIF
  305. NMATR=NBROBL
  306. NMATF=NBRFAC
  307. ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  308. IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN
  309. NBROBL=7
  310. NBRFAC=0
  311. SEGINI NOMID
  312. MOMATR=NOMID
  313. LESOBL(1)='YOUN'
  314. LESOBL(2)='V1X '
  315. LESOBL(3)='V1Y '
  316. LESOBL(4)='V1Z '
  317. LESOBL(5)='V2X '
  318. LESOBL(6)='V2Y '
  319. LESOBL(7)='V2Z '
  320. ELSE
  321. NBROBL=3
  322. NBRFAC=0
  323. SEGINI NOMID
  324. MOMATR=NOMID
  325. LESOBL(1)='YOUN'
  326. LESOBL(2)='V1X '
  327. LESOBL(3)='V1Y '
  328. ENDIF
  329. NMATR=NBROBL
  330. NMATF=NBRFAC
  331. ELSE
  332. if(lnomid(6).ne.0) then
  333. nomid=lnomid(6)
  334. segact nomid
  335. momatr=nomid
  336. nmatr=lesobl(/2)
  337. nmatf=lesfac(/2)
  338. lsupma=.false.
  339. else
  340. lsupma=.true.
  341. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  342. endif
  343. ENDIF
  344. ELSE
  345. if(lnomid(6).ne.0) then
  346. nomid=lnomid(6)
  347. segact nomid
  348. momatr=nomid
  349. nmatr=lesobl(/2)
  350. nmatf=lesfac(/2)
  351. lsupma=.false.
  352. else
  353. lsupma=.true.
  354. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  355. endif
  356. ENDIF
  357. *
  358. IF (MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN
  359. NBTYPE=3
  360. SEGINI NOTYPE
  361. TYPE(1)='POINTEURMMODEL'
  362. TYPE(2)='POINTEURMCHAML'
  363. TYPE(3)='POINTEURLISTREEL'
  364. ELSE
  365. NBTYPE=1
  366. SEGINI NOTYPE
  367. TYPE(1)='REAL*8'
  368. ENDIF
  369. MOTYPE=NOTYPE
  370. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IMAT)
  371. SEGSUP NOTYPE
  372. IF (IERR.NE.0) GOTO 9990
  373. NUMAT=NMATR+NMATF
  374. *
  375. IF (MOMATR.NE.0.AND.ISUP5.EQ.1) THEN
  376. CALL VALCHE (IMAT,NUMAT,IPMINT,IPPORE,MOMATR,MELE)
  377. ENDIF
  378. *
  379. C____________________________________________________________________
  380. C
  381. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
  382. C____________________________________________________________________
  383. C
  384. NBROBL=0
  385. NBRFAC=0
  386. NOMID=0
  387. *
  388. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  389. *
  390. IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  391. NBROBL=1
  392. NBRFAC=1
  393. SEGINI NOMID
  394. LESOBL(1)='EPAI'
  395. LESFAC(1)='EXCE'
  396. *
  397. * SECTION POUR LES BARRES
  398. *
  399. ELSE IF (MFR.EQ.27) THEN
  400. NBROBL=1
  401. SEGINI NOMID
  402. LESOBL(1)='SECT'
  403. c+mdj
  404. *
  405. * section, excentrements et orientation pour les barres excentrees
  406. *
  407. ELSE IF (MFR.EQ.49) THEN
  408. NBROBL=6
  409. SEGINI NOMID
  410. LESOBL(1)='SECT'
  411. LESOBL(2)='EXCZ'
  412. LESOBL(3)='EXCY'
  413. LESOBL(4)='VX '
  414. LESOBL(5)='VY '
  415. LESOBL(6)='VZ '
  416. *
  417. NBTYPE=1
  418. SEGINI NOTYPE
  419. MOTYPE=NOTYPE
  420. TYPE(1)='REAL*8'
  421. c+mdj
  422. *
  423. * CARACTERISTIQUES POUR LES POUTRES
  424. *
  425. ELSE IF (MFR.EQ.7 ) THEN
  426. IF (CMATE.NE.'SECTION') THEN
  427. IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  428. NBRFAC=1
  429. NBROBL=2
  430. SEGINI NOMID
  431. LESOBL(1)= 'SECT'
  432. LESOBL(2)= 'INRZ'
  433. LESFAC(1)= 'SECY'
  434. ELSE
  435. NBROBL=4
  436. NBRFAC=2
  437. SEGINI NOMID
  438. LESOBL(1)='TORS'
  439. LESOBL(2)='INRY'
  440. LESOBL(3)='INRZ'
  441. LESOBL(4)='SECT'
  442. LESFAC(1)='SECY'
  443. LESFAC(2)='SECZ'
  444. ENDIF
  445. ELSE
  446. NBROBL=0
  447. NBRFAC=1
  448. SEGINI NOMID
  449. LESFAC(1)='VECT'
  450. ENDIF
  451. *
  452. * CARACTERISTIQUES POUR LES TUYAUX
  453. *
  454. ELSE IF (MFR.EQ.13) THEN
  455. NBROBL=2
  456. NBRFAC=8
  457. SEGINI NOMID
  458. LESOBL(1)='EPAI'
  459. LESOBL(2)='RAYO'
  460. LESFAC(1)='RACO'
  461. LESFAC(2)='PRES'
  462. LESFAC(3)='CISA'
  463. LESFAC(4)='CFFX'
  464. LESFAC(5)='CFMX'
  465. LESFAC(6)='CFMY'
  466. LESFAC(7)='CFMZ'
  467. LESFAC(8)='CFPR'
  468. *
  469. * CARACTERISTIQUES POUR LES LINESPRING
  470. *
  471. ELSE IF (MFR.EQ.15) THEN
  472. NBROBL=5
  473. SEGINI NOMID
  474. LESOBL(1)='EPAI'
  475. LESOBL(2)='FISS'
  476. LESOBL(3)='VX '
  477. LESOBL(4)='VY '
  478. LESOBL(5)='VZ '
  479. *
  480. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  481. *
  482. ELSE IF (MFR.EQ.17) THEN
  483. NBROBL=9
  484. SEGINI NOMID
  485. LESOBL(1)='RAYO'
  486. LESOBL(2)='EPAI'
  487. LESOBL(3)='VX '
  488. LESOBL(4)='VY '
  489. LESOBL(5)='VZ '
  490. LESOBL(6)='VXF '
  491. LESOBL(7)='VYF '
  492. LESOBL(8)='VZF '
  493. LESOBL(9)='ANGL'
  494. *
  495. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  496. *
  497. ELSE IF (MFR.EQ.37) THEN
  498. IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  499. NBROBL=5
  500. SEGINI NOMID
  501. LESOBL(1)='SCEL'
  502. LESOBL(2)='SFLU'
  503. LESOBL(3)='EPS '
  504. LESOBL(4)='SECT'
  505. LESOBL(5)='INRZ'
  506. ELSE
  507. NBROBL=3
  508. NBRFAC=2
  509. SEGINI NOMID
  510. LESOBL(1)='SCEL'
  511. LESOBL(2)='SFLU'
  512. LESOBL(3)='EPS '
  513. LESFAC(1)='NOF1'
  514. LESFAC(2)='NOF2'
  515. ENDIF
  516. ENDIF
  517. *
  518. MOCARA=NOMID
  519. NCARA=NBROBL
  520. NCARF=NBRFAC
  521. NUCAR=NCARA+NCARF
  522. IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
  523. NBTYPE=1
  524. SEGINI NOTYPE
  525. TYPE(1)='REAL*8'
  526. IF(CMATE.EQ.'SECTION')TYPE(1)='POINTEURPOINT '
  527. MOTYPE=NOTYPE
  528. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,ICAR)
  529. SEGSUP NOTYPE
  530. IF (IERR.NE.0) GOTO 9990
  531. NOMID=MOCARA
  532. SEGDES NOMID
  533. ENDIF
  534. *
  535. IF (MOCARA.NE.0.AND.ISUP5.EQ.1) THEN
  536. CALL VALCHE (ICAR,NUCAR,IPMINT,IPPORE,MOCARA,MELE)
  537. ENDIF
  538. *
  539. RETURN
  540. *
  541. 9990 CONTINUE
  542. *
  543. * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  544. *
  545. IRET =0
  546. *
  547. IF (ISUP5.EQ.1) THEN
  548. CALL DTMVAL(IMAT,3)
  549. CALL DTMVAL(ICAR,3)
  550. ELSE
  551. CALL DTMVAL(IMAT,1)
  552. CALL DTMVAL(ICAR,1)
  553. ENDIF
  554. *
  555. NOMID=MOCARA
  556. IF (MOCARA.NE.0) SEGSUP NOMID
  557. NOMID=MOMATR
  558. IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  559. *
  560. SEGDES IMODEL
  561. *
  562. IF (IPCHE1.NE.0) THEN
  563. MCHEL1=IPCHE1
  564. SEGDES MCHEL1
  565. ENDIF
  566.  
  567. RETURN
  568. END
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  

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