Télécharger idcarb.eso

Retour à la liste

Numérotation des lignes :

  1. C IDCARB SOURCE LJ1 14/11/13 21:15:34 8248
  2. SUBROUTINE IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
  3. *--------------------------------------------------------------------*
  4. * RECHERCHE DES NOMS DE CARACTERISTIQUES *
  5. *--------------------------------------------------------------------*
  6. * *
  7. * ENTREES: *
  8. * *
  9. * MELE numero de l'element *
  10. * IFOUR issu de CCOPTIO *
  11. * *
  12. * SORTIES: *
  13. * *
  14. * IPNOMC Pointeur sur les tables de noms de composantes *
  15. * obligatoires et facultatives *
  16. * NBROBL leur nombre ( =0 si pas trouve ) *
  17. * NBRFAC leur nombre ( =0 si pas trouve ) *
  18. * *
  19. *--------------------------------------------------------------------*
  20. *
  21. IMPLICIT INTEGER(I-N)
  22. SEGMENT NOMID
  23. CHARACTER*8 LESOBL(NBROBL),LESFAC(NBRFAC)
  24. ENDSEGMENT
  25. *
  26. MFR=NUMMFR(MELE)
  27. NBROBL = 0
  28. NBRFAC = 0
  29. NOMID=0
  30. IF (MFR.EQ.1.OR.MFR.EQ.45) GOTO 9999
  31. IF (IFOUR.LT.-3.OR.IFOUR.GT.2) GOTO 9999
  32. *
  33. * element uy2 et ty3 pour advection
  34. *
  35. IF(MELE.EQ.269.or.mele.eq.270) then
  36. NBROBL=1
  37. SEGINI NOMID
  38. LESOBL(1)= 'SECT'
  39. ENDIF
  40. *
  41. * ELEMENTS CIFL MACRO ELEMENT CISAILLEMENT FLEXION
  42. *
  43. IF (MELE.EQ.258)THEN
  44. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  45. NBROBL=2
  46. SEGINI NOMID
  47. LESOBL(1)= 'SECT'
  48. LESOBL(2)= 'INRZ'
  49. ENDIF
  50. ENDIF
  51. *
  52. * COQUE MINCE OU CISAILLEMENT TRANSVERSE
  53. *
  54. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  55. NBROBL=1
  56. NBRFAC=2
  57. SEGINI NOMID
  58. LESOBL(1)='EPAI'
  59. LESFAC(1)='CALF'
  60. LESFAC(2)='EXCE'
  61. *
  62. * COQUE EPAISSE
  63. *
  64. ELSE IF (MFR.EQ.5) THEN
  65. NBROBL=1
  66. NBRFAC=1
  67. SEGINI NOMID
  68. LESOBL(1)='EPAI'
  69. LESFAC(1)='EXCE'
  70. *
  71. * POUTRES TRIDIM
  72. *
  73. ELSE IF (MFR.EQ.7) THEN
  74. IF (IFOUR.EQ.2) THEN
  75. NBRFAC=7
  76. NBROBL=4
  77. SEGINI NOMID
  78. LESOBL(1)= 'TORS'
  79. LESOBL(2)= 'INRY'
  80. LESOBL(3)= 'INRZ'
  81. LESOBL(4)= 'SECT'
  82. LESFAC(1)= 'SECY'
  83. LESFAC(2)= 'SECZ'
  84. LESFAC(3)= 'DX '
  85. LESFAC(4)= 'DY '
  86. LESFAC(5)= 'DZ '
  87. LESFAC(6)= 'OMEG'
  88. LESFAC(7)= 'VECT'
  89. *
  90. * POUTRES 2D
  91. ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  92. NBRFAC=1
  93. NBROBL=2
  94. SEGINI NOMID
  95. LESOBL(1)= 'SECT'
  96. LESOBL(2)='INRZ'
  97. LESFAC(1)= 'SECY'
  98. *
  99. ENDIF
  100. *
  101. * LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS
  102. *
  103. ELSE IF (MFR.EQ.51) THEN
  104. NBROBL=9
  105. SEGINI NOMID
  106. LESOBL(1)='RLUX'
  107. LESOBL(2)='RLUY'
  108. LESOBL(3)='RLUZ'
  109. LESOBL(4)='RLRX'
  110. LESOBL(5)='RLRY'
  111. LESOBL(6)='RLRZ'
  112. LESOBL(7)='VX '
  113. LESOBL(8)='VY '
  114. LESOBL(9)='VZ '
  115.  
  116. *
  117. * BAEX : BARRE EXCENTRE
  118. *
  119. ELSE IF (MFR.EQ.49) THEN
  120. NBROBL=6
  121. SEGINI NOMID
  122. LESOBL(1)='SECT'
  123. LESOBL(2)='EXCZ'
  124. LESOBL(3)='EXCY'
  125. LESOBL(4)='VX '
  126. LESOBL(5)='VY '
  127. LESOBL(6)='VZ '
  128. *
  129. * TUYAU ACOUSTIQUE PURE
  130. *
  131. ELSE IF (MFR.EQ.41) THEN
  132. NBROBL=1
  133. NBRFAC=1
  134. SEGINI NOMID
  135. LESOBL(1)='RAYO'
  136. LESFAC(1)='RACO'
  137. *
  138. * TUYAU TRIDIM
  139. *
  140. ELSE IF (MFR.EQ.13) THEN
  141. IF (IFOUR.EQ.2) THEN
  142. NBROBL=2
  143. NBRFAC=10
  144. SEGINI NOMID
  145. LESOBL(1)='EPAI'
  146. LESOBL(2)='RAYO'
  147. LESFAC(1)='RACO'
  148. LESFAC(2)='PRES'
  149. LESFAC(3)='CISA'
  150. LESFAC(4)='CFFX'
  151. LESFAC(5)='CFMX'
  152. LESFAC(6)='CFMY'
  153. LESFAC(7)='CFMZ'
  154. LESFAC(8)='CFPR'
  155. LESFAC(9)= 'OMEG'
  156. LESFAC(10)='VECT'
  157. ENDIF
  158. *
  159. * TUYO
  160. *
  161. ELSE IF (MFR.EQ.39) THEN
  162. IF (IFOUR.EQ.2) THEN
  163. NBROBL=2
  164. NBRFAC=3
  165. SEGINI NOMID
  166. LESOBL(1)='EPAI'
  167. LESOBL(2)='RAYO'
  168. LESFAC(1)='RACO'
  169. LESFAC(2)='PRES'
  170. LESFAC(3)='VECT'
  171. ENDIF
  172. *
  173. * LINESPRING
  174. *
  175. ELSE IF (MFR.EQ.15) THEN
  176. IF (IFOUR.EQ.2) THEN
  177. NBROBL=5
  178. SEGINI NOMID
  179. LESOBL(1)='EPAI'
  180. LESOBL(2)='FISS'
  181. LESOBL(3)='VX '
  182. LESOBL(4)='VY '
  183. LESOBL(5)='VZ '
  184. ENDIF
  185. *
  186. * TUYAU FISSURE
  187. *
  188. ELSE IF (MFR.EQ.17) THEN
  189. IF (IFOUR.EQ.2) THEN
  190. NBROBL=9
  191. SEGINI NOMID
  192. c LESOBL(1)='RAYO'
  193. c LESOBL(2)='EPAI'
  194. c LESOBL(3)='ANGL'
  195. c LESOBL(4)='VX '
  196. c LESOBL(5)='VY '
  197. c LESOBL(6)='VZ '
  198. c LESOBL(7)='VXF '
  199. c LESOBL(8)='VYF '
  200. c LESOBL(9)='VZF '
  201. LESOBL(1)='RAYO'
  202. LESOBL(2)='EPAI'
  203. LESOBL(3)='VX '
  204. LESOBL(4)='VY '
  205. LESOBL(5)='VZ '
  206. LESOBL(6)='VXF '
  207. LESOBL(7)='VYF '
  208. LESOBL(8)='VZF '
  209. LESOBL(9)='ANGL'
  210. ENDIF
  211. *
  212. * BARRE or COS2
  213. *
  214. ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  215. NBROBL=1
  216. SEGINI NOMID
  217. LESOBL(1)='SECT'
  218. *
  219. * ELEMENT HOMOGENE
  220. *
  221. ELSE IF (MFR.EQ.37) THEN
  222. IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  223. NBROBL=5
  224. SEGINI NOMID
  225. LESOBL(1)='SCEL'
  226. LESOBL(2)='SFLU'
  227. LESOBL(3)='EPS '
  228. LESOBL(4)='SECT'
  229. LESOBL(5)='INRZ'
  230. ELSE
  231. NBROBL=3
  232. NBRFAC=2
  233. SEGINI NOMID
  234. LESOBL(1)='SCEL'
  235. LESOBL(2)='SFLU'
  236. LESOBL(3)='EPS '
  237. LESFAC(1)='NOF1'
  238. LESFAC(2)='NOF2'
  239. ENDIF
  240. *
  241. * RACCORD LIQUIDE TUYAU
  242. *
  243. ELSE IF (MFR.EQ.43) THEN
  244. NBROBL=1
  245. NBRFAC=2
  246. SEGINI NOMID
  247. LESOBL(1)='RAYO'
  248. LESFAC(1)='RACO'
  249. LESFAC(2)='VECT'
  250. *
  251. * ELEMENTS DE SECTION
  252. *
  253. ELSE IF (MFR.EQ.47) THEN
  254. IF (IFOUR.EQ.2) THEN
  255. NBROBL=2
  256. SEGINI NOMID
  257. LESOBL(1)='ALPY'
  258. LESOBL(2)='ALPZ'
  259. ELSE
  260. NBROBL=1
  261. NBRFAC=0
  262. SEGINI NOMID
  263. LESOBL(1)='ALPY'
  264. ENDIF
  265. C
  266. * caracteristique supplementaire pour le SEGS
  267. IF(MELE.EQ.166)THEN
  268. NBROBL=NBROBL+1
  269. SEGADJ,NOMID
  270. LESOBL(NBROBL)='LARG'
  271. ENDIF
  272. * caracteristique supplementaire pour le POJS
  273. IF(MELE.EQ.167)THEN
  274. NBROBL=NBROBL+1
  275. SEGADJ,NOMID
  276. LESOBL(NBROBL)='SECT'
  277. ENDIF
  278. C
  279. *
  280. * JOINTS GENERALISE
  281. *
  282. ELSE IF (MFR.EQ.55) THEN
  283. CcPPj NBROBL=1
  284. CcPPj NBRFAC=0
  285. CcPPj SEGINI NOMID
  286. CcPPj LESOBL(1)='EPAI'
  287. NBROBL=0
  288. NBRFAC=1
  289. SEGINI NOMID
  290. LESFAC(1)='EPAI'
  291. *
  292. ENDIF
  293.  
  294. *
  295. 9999 CONTINUE
  296. IF (NOMID.EQ.0) SEGINI NOMID
  297.  
  298. * ajout de la densite (rendement) vectorielle du constituant kich
  299. ifac = nbrfac
  300. NBRFAC= nbrfac + 10
  301. segadj nomid
  302. lesfac(ifac + 1) = 'REND'
  303. lesfac(ifac + 2) = 'W1X '
  304. lesfac(ifac + 3) = 'W1Y '
  305. lesfac(ifac + 4) = 'W1Z '
  306. lesfac(ifac + 5) = 'W2X '
  307. lesfac(ifac + 6) = 'W2Y '
  308. lesfac(ifac + 7) = 'W2Z '
  309. lesfac(ifac + 8) = 'REN1'
  310. lesfac(ifac + 9) = 'REN2'
  311. lesfac(ifac + 10) = 'REN3'
  312.  
  313.  
  314. IPNOMC=NOMID
  315. SEGDES NOMID
  316. RETURN
  317. END
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  

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