Télécharger idcara.eso

Retour à la liste

Numérotation des lignes :

  1. C IDCARA SOURCE PASCAL 17/08/02 21:15:04 9500
  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. * LIQUIDE
  315. *
  316. ELSE IF (MFR.EQ.11.OR.MFR.EQ.19.OR.MFR.EQ.21) THEN
  317. IF (IFOUR.EQ.2) THEN
  318. NBROBL=0
  319. NBRFAC=3
  320. SEGINI NOMID
  321. LESFAC(1)='VX'
  322. LESFAC(2)='VY'
  323. LESFAC(3)='VZ'
  324.  
  325. ELSE
  326. NBROBL=0
  327. NBRFAC=2
  328. SEGINI NOMID
  329. LESFAC(1)='VX'
  330. LESFAC(2)='VY'
  331. ENDIF
  332. *
  333. ENDIF
  334.  
  335. C write(6,*) 'MFR =',MFR
  336.  
  337.  
  338. C Par DEFAUT : segment VIDE
  339. C ===========================
  340. IF (NOMID.EQ.0) THEN
  341. SEGINI,NOMID
  342. ELSE
  343. if (ifomod.eq.6) then
  344. nbrfa0 = nbrfac
  345. NBRFAC = NBROBL + (nbrfa0*2)
  346. segadj nomid
  347. do imo = 1,nbrobl
  348. lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  349. lesfac(nbrfa0 + imo)(1:1) = 'I'
  350. enddo
  351. do imo = 1,nbrfa0
  352. lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  353. lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  354. enddo
  355. endif
  356. ENDIF
  357.  
  358. IPNOMC=NOMID
  359. RETURN
  360.  
  361.  
  362.  
  363.  
  364. C Formulation THERMIQUE
  365. C ===========================
  366. 1001 CONTINUE
  367. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  368. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  369. NBROBL=1
  370. SEGINI NOMID
  371. LESOBL(1)= 'SECT'
  372.  
  373. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  374. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  375. NBROBL=1
  376. NBRFAC=1
  377. SEGINI NOMID
  378. LESOBL(1)='EPAI '
  379. LESFAC(1)='EXCE '
  380.  
  381. ELSE
  382. C MASSIF pour CONDUCTION
  383. NBROBL=0
  384. SEGINI NOMID
  385. ENDIF
  386. IPNOMC=NOMID
  387. RETURN
  388.  
  389. C Formulation DIFFUSION
  390. C ===========================
  391. 1002 CONTINUE
  392. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  393. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  394. NBROBL=1
  395. SEGINI NOMID
  396. LESOBL(1)= 'SECT'
  397.  
  398. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  399. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  400. NBROBL=1
  401. NBRFAC=1
  402. SEGINI NOMID
  403. LESOBL(1)='EPAI '
  404. LESFAC(1)='EXCE '
  405.  
  406. ELSE
  407. C MASSIF pour CONDUCTION
  408. NBROBL=0
  409. SEGINI NOMID
  410. ENDIF
  411. IPNOMC=NOMID
  412. RETURN
  413.  
  414.  
  415.  
  416. 1003 CONTINUE
  417. C ajout de la densite (rendement) vectorielle du constituant kich
  418. IF (NOMID.EQ.0) SEGINI NOMID
  419.  
  420. ifac = nbrfac
  421. NBRFAC= nbrfac + 10
  422. segadj nomid
  423. lesfac(ifac + 1) = 'REND'
  424. lesfac(ifac + 2) = 'W1X '
  425. lesfac(ifac + 3) = 'W1Y '
  426. lesfac(ifac + 4) = 'W1Z '
  427. lesfac(ifac + 5) = 'W2X '
  428. lesfac(ifac + 6) = 'W2Y '
  429. lesfac(ifac + 7) = 'W2Z '
  430. lesfac(ifac + 8) = 'REN1'
  431. lesfac(ifac + 9) = 'REN2'
  432. lesfac(ifac + 10)= 'REN3'
  433.  
  434.  
  435. IPNOMC=NOMID
  436. RETURN
  437. END
  438.  
  439.  
  440.  
  441.  

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