Télécharger idcara.eso

Retour à la liste

Numérotation des lignes :

  1. C IDCARA SOURCE CB215821 17/01/16 21:15:36 9279
  2. SUBROUTINE IDCARA(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
  3. *--------------------------------------------------------------------*
  4. * RECHERCHE DES NOMS DE CARACTERISTIQUES *
  5. *--------------------------------------------------------------------*
  6. * *
  7. * ENTREES: *
  8. * *
  9. * IPMODE Pointeur sur un MMODEL.KMODEL *
  10. * MFR0 Numero de Formulation *
  11. * - Sert seulement si different de celui calcule avec IMODEL *
  12. * *
  13. * SORTIES: *
  14. * *
  15. * IPNOMC Pointeur sur les tables de noms de composantes *
  16. * obligatoires et facultatives *
  17. * NBROBL leur nombre ( =0 si pas trouve ) *
  18. * NBRFAC leur nombre ( =0 si pas trouve ) *
  19. * *
  20. *--------------------------------------------------------------------*
  21. *
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. CHARACTER*16 NOM16
  26.  
  27. -INC CCOPTIO
  28. -INC SMMODEL
  29.  
  30. NOMID =0
  31. NBROBL=0
  32. NBRFAC=0
  33. IMODEL=IPMODE
  34. C Recuperation de IFOUR dans CCOPTIO.INC
  35. IFOU = IFOUR
  36. MELE = NEFMOD
  37. MFR = NUMMFR(MELE)
  38.  
  39. C On suppose que le IMODEL est actif
  40. C SEGACT,IMODEL
  41. NOMID = IMODEL.LNOMID(7)
  42.  
  43. C S'ils sont déjà présents dans le IMODEL on ne se les refait pas...
  44. IF(NOMID .NE. 0 .AND. (MFR .EQ. MFR0))THEN
  45. SEGACT,NOMID
  46. NBROBL=LESOBL(/2)
  47. NBRFAC=LESFAC(/2)
  48. IPNOMC = NOMID
  49. RETURN
  50. ENDIF
  51.  
  52. C Sinon on les détermine
  53. MFR = MFR0
  54.  
  55. C Cas un peu particuliers de la THERMIQUE et de la DIFFUSION
  56. NOM16=FORMOD(1)
  57. IF(NOM16 .EQ. 'THERMIQUE ') GOTO 1001
  58. IF(NOM16 .EQ. 'DIFFUSION ') GOTO 1002
  59.  
  60. IF (MFR .EQ.1 .OR. MFR .EQ.45) GOTO 1003
  61. IF (IFOUR.LT.-3 .OR. IFOUR.GT.2 ) GOTO 1003
  62. *
  63. * ELEMENTS CIFL MACRO ELEMENT CISAILLEMENT FLEXION
  64. *
  65. IF (MELE.EQ.258)THEN
  66. IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  67. NBROBL=2
  68. SEGINI NOMID
  69. LESOBL(1)= 'SECT'
  70. LESOBL(2)= 'INRZ'
  71. ENDIF
  72. ENDIF
  73. *
  74. * COQUE MINCE OU CISAILLEMENT TRANSVERSE
  75. *
  76. IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  77. NBROBL=1
  78. NBRFAC=2
  79. SEGINI NOMID
  80. LESOBL(1)='EPAI'
  81. LESFAC(1)='CALF'
  82. LESFAC(2)='EXCE'
  83. *
  84. * COQUE EPAISSE
  85. *
  86. ELSE IF (MFR.EQ.5) THEN
  87. NBROBL=1
  88. NBRFAC=1
  89. SEGINI NOMID
  90. LESOBL(1)='EPAI'
  91. LESFAC(1)='EXCE'
  92. *
  93. * POUTRES TRIDIM
  94. *
  95. ELSE IF (MFR.EQ.7) THEN
  96. IF (IFOUR.EQ.2) THEN
  97. NBRFAC=7
  98. NBROBL=4
  99. SEGINI NOMID
  100. LESOBL(1)= 'TORS'
  101. LESOBL(2)= 'INRY'
  102. LESOBL(3)= 'INRZ'
  103. LESOBL(4)= 'SECT'
  104. LESFAC(1)= 'SECY'
  105. LESFAC(2)= 'SECZ'
  106. LESFAC(3)= 'DX '
  107. LESFAC(4)= 'DY '
  108. LESFAC(5)= 'DZ '
  109. LESFAC(6)= 'OMEG'
  110. LESFAC(7)= 'VECT'
  111. *
  112. * POUTRES 2D
  113. ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  114. NBRFAC=1
  115. NBROBL=2
  116. SEGINI NOMID
  117. LESOBL(1)= 'SECT'
  118. LESOBL(2)='INRZ'
  119. LESFAC(1)= 'SECY'
  120. *
  121. ENDIF
  122. *
  123. * LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS
  124. *
  125. ELSE IF (MFR.EQ.51) THEN
  126. NBROBL=9
  127. SEGINI NOMID
  128. LESOBL(1)='RLUX'
  129. LESOBL(2)='RLUY'
  130. LESOBL(3)='RLUZ'
  131. LESOBL(4)='RLRX'
  132. LESOBL(5)='RLRY'
  133. LESOBL(6)='RLRZ'
  134. LESOBL(7)='VX '
  135. LESOBL(8)='VY '
  136. LESOBL(9)='VZ '
  137.  
  138. *
  139. * BAEX : BARRE EXCENTRE
  140. *
  141. ELSE IF (MFR.EQ.49) THEN
  142. NBROBL=6
  143. SEGINI NOMID
  144. LESOBL(1)='SECT'
  145. LESOBL(2)='EXCZ'
  146. LESOBL(3)='EXCY'
  147. LESOBL(4)='VX '
  148. LESOBL(5)='VY '
  149. LESOBL(6)='VZ '
  150. *
  151. * TUYAU ACOUSTIQUE PURE
  152. *
  153. ELSE IF (MFR.EQ.41) THEN
  154. NBROBL=1
  155. NBRFAC=1
  156. SEGINI NOMID
  157. LESOBL(1)='RAYO'
  158. LESFAC(1)='RACO'
  159. *
  160. * TUYAU TRIDIM
  161. *
  162. ELSE IF (MFR.EQ.13) THEN
  163. IF (IFOUR.EQ.2) THEN
  164. NBROBL=2
  165. NBRFAC=10
  166. SEGINI NOMID
  167. LESOBL(1)='EPAI'
  168. LESOBL(2)='RAYO'
  169. LESFAC(1)='RACO'
  170. LESFAC(2)='PRES'
  171. LESFAC(3)='CISA'
  172. LESFAC(4)='CFFX'
  173. LESFAC(5)='CFMX'
  174. LESFAC(6)='CFMY'
  175. LESFAC(7)='CFMZ'
  176. LESFAC(8)='CFPR'
  177. LESFAC(9)= 'OMEG'
  178. LESFAC(10)='VECT'
  179. ENDIF
  180. *
  181. * TUYO
  182. *
  183. ELSE IF (MFR.EQ.39) THEN
  184. IF (IFOUR.EQ.2) THEN
  185. NBROBL=2
  186. NBRFAC=3
  187. SEGINI NOMID
  188. LESOBL(1)='EPAI'
  189. LESOBL(2)='RAYO'
  190. LESFAC(1)='RACO'
  191. LESFAC(2)='PRES'
  192. LESFAC(3)='VECT'
  193. ENDIF
  194. *
  195. * LINESPRING
  196. *
  197. ELSE IF (MFR.EQ.15) THEN
  198. IF (IFOUR.EQ.2) THEN
  199. NBROBL=5
  200. SEGINI NOMID
  201. LESOBL(1)='EPAI'
  202. LESOBL(2)='FISS'
  203. LESOBL(3)='VX '
  204. LESOBL(4)='VY '
  205. LESOBL(5)='VZ '
  206. ENDIF
  207. *
  208. * TUYAU FISSURE
  209. *
  210. ELSE IF (MFR.EQ.17) THEN
  211. IF (IFOUR.EQ.2) THEN
  212. NBROBL=9
  213. SEGINI NOMID
  214. c LESOBL(1)='RAYO'
  215. c LESOBL(2)='EPAI'
  216. c LESOBL(3)='ANGL'
  217. c LESOBL(4)='VX '
  218. c LESOBL(5)='VY '
  219. c LESOBL(6)='VZ '
  220. c LESOBL(7)='VXF '
  221. c LESOBL(8)='VYF '
  222. c LESOBL(9)='VZF '
  223. LESOBL(1)='RAYO'
  224. LESOBL(2)='EPAI'
  225. LESOBL(3)='VX '
  226. LESOBL(4)='VY '
  227. LESOBL(5)='VZ '
  228. LESOBL(6)='VXF '
  229. LESOBL(7)='VYF '
  230. LESOBL(8)='VZF '
  231. LESOBL(9)='ANGL'
  232. ENDIF
  233. *
  234. * BARRE or COS2
  235. *
  236. ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  237. NBROBL=1
  238. SEGINI NOMID
  239. LESOBL(1)='SECT'
  240. *
  241. * ELEMENT HOMOGENE
  242. *
  243. ELSE IF (MFR.EQ.37) THEN
  244. IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  245. NBROBL=5
  246. SEGINI NOMID
  247. LESOBL(1)='SCEL'
  248. LESOBL(2)='SFLU'
  249. LESOBL(3)='EPS '
  250. LESOBL(4)='SECT'
  251. LESOBL(5)='INRZ'
  252. ELSE
  253. NBROBL=3
  254. NBRFAC=2
  255. SEGINI NOMID
  256. LESOBL(1)='SCEL'
  257. LESOBL(2)='SFLU'
  258. LESOBL(3)='EPS '
  259. LESFAC(1)='NOF1'
  260. LESFAC(2)='NOF2'
  261. ENDIF
  262. *
  263. * RACCORD LIQUIDE TUYAU
  264. *
  265. ELSE IF (MFR.EQ.43) THEN
  266. NBROBL=1
  267. NBRFAC=2
  268. SEGINI NOMID
  269. LESOBL(1)='RAYO'
  270. LESFAC(1)='RACO'
  271. LESFAC(2)='VECT'
  272. *
  273. * ELEMENTS DE SECTION
  274. *
  275. ELSE IF (MFR.EQ.47) THEN
  276. IF (IFOUR.EQ.2) THEN
  277. NBROBL=2
  278. SEGINI NOMID
  279. LESOBL(1)='ALPY'
  280. LESOBL(2)='ALPZ'
  281. ELSE
  282. NBROBL=1
  283. NBRFAC=0
  284. SEGINI NOMID
  285. LESOBL(1)='ALPY'
  286. ENDIF
  287. C
  288. * caracteristique supplementaire pour le SEGS
  289. IF(MELE.EQ.166)THEN
  290. NBROBL=NBROBL+1
  291. SEGADJ,NOMID
  292. LESOBL(NBROBL)='LARG'
  293. ENDIF
  294. * caracteristique supplementaire pour le POJS
  295. IF(MELE.EQ.167)THEN
  296. NBROBL=NBROBL+1
  297. SEGADJ,NOMID
  298. LESOBL(NBROBL)='SECT'
  299. ENDIF
  300. C
  301. *
  302. * JOINTS GENERALISE
  303. *
  304. ELSE IF (MFR.EQ.55) THEN
  305. CcPPj NBROBL=1
  306. CcPPj NBRFAC=0
  307. CcPPj SEGINI NOMID
  308. CcPPj LESOBL(1)='EPAI'
  309. NBROBL=0
  310. NBRFAC=1
  311. SEGINI NOMID
  312. LESFAC(1)='EPAI'
  313. *
  314. ENDIF
  315.  
  316.  
  317.  
  318. C Par DEFAUT : segment VIDE
  319. C ===========================
  320. IF (NOMID.EQ.0) THEN
  321. SEGINI,NOMID
  322. ELSE
  323. if (ifomod.eq.6) then
  324. nbrfa0 = nbrfac
  325. NBRFAC = NBROBL + (nbrfa0*2)
  326. segadj nomid
  327. do imo = 1,nbrobl
  328. lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  329. lesfac(nbrfa0 + imo)(1:1) = 'I'
  330. enddo
  331. do imo = 1,nbrfa0
  332. lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  333. lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  334. enddo
  335. endif
  336. ENDIF
  337.  
  338. IPNOMC=NOMID
  339. RETURN
  340.  
  341.  
  342.  
  343.  
  344. C Formulation THERMIQUE
  345. C ===========================
  346. 1001 CONTINUE
  347. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  348. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  349. NBROBL=1
  350. SEGINI NOMID
  351. LESOBL(1)= 'SECT'
  352.  
  353. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  354. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  355. NBROBL=1
  356. NBRFAC=1
  357. SEGINI NOMID
  358. LESOBL(1)='EPAI '
  359. LESFAC(1)='EXCE '
  360.  
  361. ELSE
  362. C MASSIF pour CONDUCTION
  363. NBROBL=0
  364. SEGINI NOMID
  365. ENDIF
  366. IPNOMC=NOMID
  367. RETURN
  368.  
  369. C Formulation DIFFUSION
  370. C ===========================
  371. 1002 CONTINUE
  372. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  373. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  374. NBROBL=1
  375. SEGINI NOMID
  376. LESOBL(1)= 'SECT'
  377.  
  378. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  379. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  380. NBROBL=1
  381. NBRFAC=1
  382. SEGINI NOMID
  383. LESOBL(1)='EPAI '
  384. LESFAC(1)='EXCE '
  385.  
  386. ELSE
  387. C MASSIF pour CONDUCTION
  388. NBROBL=0
  389. SEGINI NOMID
  390. ENDIF
  391. IPNOMC=NOMID
  392. RETURN
  393.  
  394.  
  395.  
  396. 1003 CONTINUE
  397. C ajout de la densite (rendement) vectorielle du constituant kich
  398. IF (NOMID.EQ.0) SEGINI NOMID
  399.  
  400. ifac = nbrfac
  401. NBRFAC= nbrfac + 10
  402. segadj nomid
  403. lesfac(ifac + 1) = 'REND'
  404. lesfac(ifac + 2) = 'W1X '
  405. lesfac(ifac + 3) = 'W1Y '
  406. lesfac(ifac + 4) = 'W1Z '
  407. lesfac(ifac + 5) = 'W2X '
  408. lesfac(ifac + 6) = 'W2Y '
  409. lesfac(ifac + 7) = 'W2Z '
  410. lesfac(ifac + 8) = 'REN1'
  411. lesfac(ifac + 9) = 'REN2'
  412. lesfac(ifac + 10)= 'REN3'
  413.  
  414.  
  415. IPNOMC=NOMID
  416. RETURN
  417. END
  418.  
  419.  
  420.  

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