Télécharger carmat.eso

Retour à la liste

Numérotation des lignes :

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

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