Télécharger idcara.eso

Retour à la liste

Numérotation des lignes :

  1. C IDCARA SOURCE PASCAL 18/11/09 21:15:08 9987
  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=2
  115. NBROBL=2
  116. SEGINI NOMID
  117. LESOBL(1)= 'SECT'
  118. LESOBL(2)= 'INRZ'
  119. LESFAC(1)= 'SECY'
  120. LESFAC(2)= 'DY '
  121. *
  122. ENDIF
  123. *
  124. * LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS
  125. *
  126. ELSE IF (MFR.EQ.51) THEN
  127. NBROBL=9
  128. SEGINI NOMID
  129. LESOBL(1)='RLUX'
  130. LESOBL(2)='RLUY'
  131. LESOBL(3)='RLUZ'
  132. LESOBL(4)='RLRX'
  133. LESOBL(5)='RLRY'
  134. LESOBL(6)='RLRZ'
  135. LESOBL(7)='VX '
  136. LESOBL(8)='VY '
  137. LESOBL(9)='VZ '
  138.  
  139. *
  140. * BAEX : BARRE EXCENTRE
  141. *
  142. ELSE IF (MFR.EQ.49) THEN
  143. NBROBL=6
  144. SEGINI NOMID
  145. LESOBL(1)='SECT'
  146. LESOBL(2)='EXCZ'
  147. LESOBL(3)='EXCY'
  148. LESOBL(4)='VX '
  149. LESOBL(5)='VY '
  150. LESOBL(6)='VZ '
  151. *
  152. * TUYAU ACOUSTIQUE PURE
  153. *
  154. ELSE IF (MFR.EQ.41) THEN
  155. NBROBL=1
  156. NBRFAC=1
  157. SEGINI NOMID
  158. LESOBL(1)='RAYO'
  159. LESFAC(1)='RACO'
  160. *
  161. * TUYAU TRIDIM
  162. *
  163. ELSE IF (MFR.EQ.13) THEN
  164. IF (IFOUR.EQ.2) THEN
  165. NBROBL=2
  166. NBRFAC=10
  167. SEGINI NOMID
  168. LESOBL(1)='EPAI'
  169. LESOBL(2)='RAYO'
  170. LESFAC(1)='RACO'
  171. LESFAC(2)='PRES'
  172. LESFAC(3)='CISA'
  173. LESFAC(4)='CFFX'
  174. LESFAC(5)='CFMX'
  175. LESFAC(6)='CFMY'
  176. LESFAC(7)='CFMZ'
  177. LESFAC(8)='CFPR'
  178. LESFAC(9)= 'OMEG'
  179. LESFAC(10)='VECT'
  180. ENDIF
  181. *
  182. * TUYO
  183. *
  184. ELSE IF (MFR.EQ.39) THEN
  185. IF (IFOUR.EQ.2) THEN
  186. NBROBL=2
  187. NBRFAC=3
  188. SEGINI NOMID
  189. LESOBL(1)='EPAI'
  190. LESOBL(2)='RAYO'
  191. LESFAC(1)='RACO'
  192. LESFAC(2)='PRES'
  193. LESFAC(3)='VECT'
  194. ENDIF
  195. *
  196. * LINESPRING
  197. *
  198. ELSE IF (MFR.EQ.15) THEN
  199. IF (IFOUR.EQ.2) THEN
  200. NBROBL=5
  201. SEGINI NOMID
  202. LESOBL(1)='EPAI'
  203. LESOBL(2)='FISS'
  204. LESOBL(3)='VX '
  205. LESOBL(4)='VY '
  206. LESOBL(5)='VZ '
  207. ENDIF
  208. *
  209. * TUYAU FISSURE
  210. *
  211. ELSE IF (MFR.EQ.17) THEN
  212. IF (IFOUR.EQ.2) THEN
  213. NBROBL=9
  214. SEGINI NOMID
  215. c LESOBL(1)='RAYO'
  216. c LESOBL(2)='EPAI'
  217. c LESOBL(3)='ANGL'
  218. c LESOBL(4)='VX '
  219. c LESOBL(5)='VY '
  220. c LESOBL(6)='VZ '
  221. c LESOBL(7)='VXF '
  222. c LESOBL(8)='VYF '
  223. c LESOBL(9)='VZF '
  224. LESOBL(1)='RAYO'
  225. LESOBL(2)='EPAI'
  226. LESOBL(3)='VX '
  227. LESOBL(4)='VY '
  228. LESOBL(5)='VZ '
  229. LESOBL(6)='VXF '
  230. LESOBL(7)='VYF '
  231. LESOBL(8)='VZF '
  232. LESOBL(9)='ANGL'
  233. ENDIF
  234. *
  235. * BARRE or COS2
  236. *
  237. ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  238. NBROBL=1
  239. SEGINI NOMID
  240. LESOBL(1)='SECT'
  241. *
  242. * ELEMENT HOMOGENE
  243. *
  244. ELSE IF (MFR.EQ.37) THEN
  245. IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  246. NBROBL=5
  247. SEGINI NOMID
  248. LESOBL(1)='SCEL'
  249. LESOBL(2)='SFLU'
  250. LESOBL(3)='EPS '
  251. LESOBL(4)='SECT'
  252. LESOBL(5)='INRZ'
  253. ELSE
  254. NBROBL=3
  255. NBRFAC=2
  256. SEGINI NOMID
  257. LESOBL(1)='SCEL'
  258. LESOBL(2)='SFLU'
  259. LESOBL(3)='EPS '
  260. LESFAC(1)='NOF1'
  261. LESFAC(2)='NOF2'
  262. ENDIF
  263. *
  264. * RACCORD LIQUIDE TUYAU
  265. *
  266. ELSE IF (MFR.EQ.43) THEN
  267. NBROBL=1
  268. NBRFAC=2
  269. SEGINI NOMID
  270. LESOBL(1)='RAYO'
  271. LESFAC(1)='RACO'
  272. LESFAC(2)='VECT'
  273. *
  274. * ELEMENTS DE SECTION
  275. *
  276. ELSE IF (MFR.EQ.47) THEN
  277. IF (IFOUR.EQ.2) THEN
  278. NBROBL=2
  279. SEGINI NOMID
  280. LESOBL(1)='ALPY'
  281. LESOBL(2)='ALPZ'
  282. ELSE
  283. NBROBL=1
  284. NBRFAC=0
  285. SEGINI NOMID
  286. LESOBL(1)='ALPY'
  287. ENDIF
  288. C
  289. * caracteristique supplementaire pour le SEGS
  290. IF(MELE.EQ.166)THEN
  291. NBROBL=NBROBL+1
  292. SEGADJ,NOMID
  293. LESOBL(NBROBL)='LARG'
  294. ENDIF
  295. * caracteristique supplementaire pour le POJS
  296. IF(MELE.EQ.167)THEN
  297. NBROBL=NBROBL+1
  298. SEGADJ,NOMID
  299. LESOBL(NBROBL)='SECT'
  300. ENDIF
  301. C
  302. *
  303. * JOINTS GENERALISE
  304. *
  305. ELSE IF (MFR.EQ.55) THEN
  306. CcPPj NBROBL=1
  307. CcPPj NBRFAC=0
  308. CcPPj SEGINI NOMID
  309. CcPPj LESOBL(1)='EPAI'
  310. NBROBL=0
  311. NBRFAC=1
  312. SEGINI NOMID
  313. LESFAC(1)='EPAI'
  314. *
  315. * LIQUIDE
  316. *
  317. ELSE IF (MFR.EQ.11.OR.MFR.EQ.19.OR.MFR.EQ.21) THEN
  318. IF (IFOUR.EQ.2) THEN
  319. NBROBL=0
  320. NBRFAC=3
  321. SEGINI NOMID
  322. LESFAC(1)='VX'
  323. LESFAC(2)='VY'
  324. LESFAC(3)='VZ'
  325.  
  326. ELSE
  327. NBROBL=0
  328. NBRFAC=2
  329. SEGINI NOMID
  330. LESFAC(1)='VX'
  331. LESFAC(2)='VY'
  332. ENDIF
  333. *
  334. ENDIF
  335.  
  336. C write(6,*) 'MFR =',MFR
  337.  
  338.  
  339. C Par DEFAUT : segment VIDE
  340. C ===========================
  341. IF (NOMID.EQ.0) THEN
  342. SEGINI,NOMID
  343. ELSE
  344. if (ifomod.eq.6) then
  345. nbrfa0 = nbrfac
  346. NBRFAC = NBROBL + (nbrfa0*2)
  347. segadj nomid
  348. do imo = 1,nbrobl
  349. lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  350. lesfac(nbrfa0 + imo)(1:1) = 'I'
  351. enddo
  352. do imo = 1,nbrfa0
  353. lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  354. lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  355. enddo
  356. endif
  357. ENDIF
  358.  
  359. IPNOMC=NOMID
  360. RETURN
  361.  
  362.  
  363.  
  364.  
  365. C Formulation THERMIQUE
  366. C ===========================
  367. 1001 CONTINUE
  368. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  369. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  370. NBROBL=1
  371. SEGINI NOMID
  372. LESOBL(1)= 'SECT'
  373.  
  374. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  375. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  376. NBROBL=1
  377. NBRFAC=1
  378. SEGINI NOMID
  379. LESOBL(1)='EPAI '
  380. LESFAC(1)='EXCE '
  381.  
  382. ELSE
  383. C MASSIF pour CONDUCTION
  384. NBROBL=0
  385. SEGINI NOMID
  386. ENDIF
  387. IPNOMC=NOMID
  388. RETURN
  389.  
  390. C Formulation DIFFUSION
  391. C ===========================
  392. 1002 CONTINUE
  393. IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  394. C TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  395. NBROBL=1
  396. SEGINI NOMID
  397. LESOBL(1)= 'SECT'
  398.  
  399. ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  400. C COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  401. NBROBL=1
  402. NBRFAC=1
  403. SEGINI NOMID
  404. LESOBL(1)='EPAI '
  405. LESFAC(1)='EXCE '
  406.  
  407. ELSE
  408. C MASSIF pour CONDUCTION
  409. NBROBL=0
  410. SEGINI NOMID
  411. ENDIF
  412. IPNOMC=NOMID
  413. RETURN
  414.  
  415.  
  416.  
  417. 1003 CONTINUE
  418. C ajout de la densite (rendement) vectorielle du constituant kich
  419. IF (NOMID.EQ.0) SEGINI NOMID
  420.  
  421. ifac = nbrfac
  422. NBRFAC= nbrfac + 10
  423. segadj nomid
  424. lesfac(ifac + 1) = 'REND'
  425. lesfac(ifac + 2) = 'W1X '
  426. lesfac(ifac + 3) = 'W1Y '
  427. lesfac(ifac + 4) = 'W1Z '
  428. lesfac(ifac + 5) = 'W2X '
  429. lesfac(ifac + 6) = 'W2Y '
  430. lesfac(ifac + 7) = 'W2Z '
  431. lesfac(ifac + 8) = 'REN1'
  432. lesfac(ifac + 9) = 'REN2'
  433. lesfac(ifac + 10)= 'REN3'
  434.  
  435.  
  436. IPNOMC=NOMID
  437. RETURN
  438. END
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  

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