Télécharger demcha.eso

Retour à la liste

Numérotation des lignes :

  1. C DEMCHA SOURCE CB215821 19/08/20 21:16:36 10287
  2. SUBROUTINE DEMCHA(IPT8,MELEME)
  3. *
  4. * met en element quadratique un maillage meleme.
  5. * on teste dans ipt8 si des elements quadratiques existent deja
  6. *
  7. * SG 2016/07/21 : ajout gestion des elements QUAF
  8. *
  9. IMPLICIT INTEGER(I-N)
  10. -INC SMELEME
  11. -INC CCOPTIO
  12. -INC CCGEOME
  13. -INC SMCOORD
  14. logical ltelq
  15. SEGMENT KONPOS(NBPTS)
  16. SEGMENT KONFIN(IKOUR)
  17. SEGMENT KONMIL(IKOUR)
  18. SEGMENT KONSUI(IKOUR)
  19. SEGMENT INOU(NBS)
  20. *
  21. PARAMETER(NQUAF=2+4)
  22. * Tableau indiquant les numeros des elements QUAFs (quadratiques
  23. * fluides) et des QUADs (quadratiques normaux) correspondant
  24. * cf. tableau NOMS de bdata.eso
  25. *
  26. INTEGER ITQUAF(NQUAF)
  27. INTEGER ITQUAD(NQUAF)
  28. * TRI7 QUA9 CU27 PR21 TE15 PY19
  29. DATA ITQUAF/ 7 , 11, 33, 34, 35, 36/
  30. * TRI6 QUA8 CU20 PR15 TE10 PY13
  31. DATA ITQUAD/ 6 , 10, 15, 17, 24, 26/
  32. *
  33. *
  34. * I PRISE EN COMPTE DU MAILLAGE DE SURFACE
  35. NBPTS=XCOOR(/1)/(IDIM+1)
  36. SEGINI KONPOS
  37. IKOUR=4*NBPTS
  38. SEGINI KONFIN,KONMIL,KONSUI
  39. KONCOU=0
  40. *
  41. * traitement des elements deja quadratiques
  42. *
  43. SEGACT IPT8
  44. IPT7=IPT8
  45. NBSOUS=IPT8.LISOUS(/1)
  46. DO 60 ISOUS=1,MAX(1,NBSOUS)
  47. IF (NBSOUS.NE.0) IPT7=IPT8.LISOUS(ISOUS)
  48. SEGACT IPT7
  49. ITY= IPT7.ITYPEL
  50. ISUP=0
  51. IF(KDEGRE(ITY).NE.3) GOTO 61
  52. IF(ITY.NE.3) THEN
  53. ISUP=1
  54. CALL ECROBJ('MAILLAGE', IPT7)
  55. CALL CHANLG
  56. CALL LIROBJ('MAILLAGE',IPT7,1,IRETOU)
  57. IF(IERR.NE.0) RETURN
  58. SEGACT IPT7
  59. ENDIF
  60. DO 70 J=1,IPT7.NUM(/2)
  61. I1=IPT7.NUM(1,J)
  62. I3=IPT7.NUM(3,J)
  63. J1=MIN(I1,I3)
  64. J3=MAX(I1,I3)
  65. ITFA=KONPOS(J1)
  66. IF (ITFA.EQ.0) GOTO 90
  67. 85 CONTINUE
  68. ITF=KONSUI(ITFA)
  69. IF (KONFIN(ITFA).EQ.J3) GOTO 70
  70. IF (ITF.EQ.0) GOTO 90
  71. ITFA=ITF
  72. GOTO 85
  73. 90 KONCOU=KONCOU+1
  74. IF (KONCOU.GE.KONFIN(/1)) THEN
  75. IKOUR=KONCOU+500
  76. SEGADJ KONFIN,KONMIL,KONSUI
  77. ENDIF
  78. IF (ITFA.EQ.0) THEN
  79. KONPOS(J1)=KONCOU
  80. ELSE
  81. KONSUI(ITFA)=KONCOU
  82. ENDIF
  83. KONFIN(KONCOU)=J3
  84. KONMIL(KONCOU)=IPT7.NUM(2,J)
  85. 70 CONTINUE
  86. 61 CONTINUE
  87. IF(ISUP.NE.0) THEN
  88. SEGSUP IPT7
  89. ENDIF
  90. 60 CONTINUE
  91. * MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire
  92. * SG 2016/07/21 et/ou des QUAF (dans ce dernier cas, il suffit
  93. * d'oublier les noeuds au centre des faces et de l'element)
  94.  
  95. IPT7=MELEME
  96. SEGACT MELEME
  97. NBSOU7=LISOUS(/1)
  98. NBSOUS=NBSOU7
  99. NBS = MAX(1,NBSOU7)
  100. SEGINI INOU
  101. NBREF=0
  102. NBELEM=0
  103. NBNN=0
  104. DO 100 ISOUS=1,MAX(1,NBSOU7)
  105. IF (NBSOU7.NE.0) IPT7=LISOUS(ISOUS)
  106. SEGACT IPT7
  107. INOU(ISOUS)=IPT7
  108. NBELEM=IPT7.NUM(/2)
  109. ITY=IPT7.ITYPEL
  110. * l'element est-il un quadratique fluide (quaf) ?
  111. iquaf=0
  112. do i=1,nquaf
  113. if (ity.eq.itquaf(i)) then
  114. iquaf=i
  115. goto 666
  116. endif
  117. enddo
  118. 666 continue
  119. * oui, c'est un quaf, on ne garde que les noeuds quadratiques
  120. * "normaux" (par chance de la definition des quaf, ce sont les n premiers)
  121. if (iquaf.ne.0) then
  122. itype=itquad(iquaf)
  123. NBNN=NBNNE(ITYPE)
  124. NBSOUS=0
  125. NBREF=0
  126. SEGINI IPT6
  127. IPT6.ITYPEL=ITYPE
  128. INOU(ISOUS)=IPT6
  129. DO J=1,NBELEM
  130. DO I=1,NBNN
  131. IPT6.NUM(I,J)=IPT7.NUM(I,J)
  132. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  133. ENDDO
  134. ENDDO
  135. goto 101
  136. endif
  137. ITYPE=IPT7.ITYPEL+1
  138. IF(IPT7.ITYPEL.EQ.4 . OR. IPT7.ITYPEL.EQ.5. OR .
  139. #IPT7.ITYPEL.EQ.8 . OR. IPT7.ITYPEL.EQ.9. OR.
  140. #IPT7.ITYPEL.EQ.18 . OR. IPT7.ITYPEL.EQ.19) ITYPE=ITYPE+1
  141. NBNN=NBNNE(ITYPE)
  142. NBSOUS=0
  143. NBREF=0
  144. SEGINI IPT6
  145. IPT6.ITYPEL=ITYPE
  146. * IF (NBSOU7.NE.0) IPT1.LISOUS(ISOUS)=IPT6
  147. * CAS DES TETRAEDRES
  148. IF (IPT7.ITYPEL.EQ.23) THEN
  149. INOU(ISOUS)=IPT6
  150. DO 200 J=1,NBELEM
  151. I1=IPT7.NUM(1,J)
  152. I2=IPT7.NUM(2,J)
  153. I3=IPT7.NUM(3,J)
  154. I4=IPT7.NUM(4,J)
  155. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  156. IPT6.NUM(1,J)=I1
  157. IPT6.NUM(2,J)=I5
  158. IPT6.NUM(3,J)=I2
  159. CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  160. IPT6.NUM(4,J)=I5
  161. IPT6.NUM(5,J)=I3
  162. CALL DEMCH1(I3,I1,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  163. IPT6.NUM(6,J)=I5
  164. CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  165. IPT6.NUM(7,J)=I5
  166. CALL DEMCH1(I2,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  167. IPT6.NUM(8,J)=I5
  168. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  169. IPT6.NUM(9,J)=I5
  170. IPT6.NUM(10,J)=I4
  171. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  172. 200 CONTINUE
  173. * CAS DES PYRAMIDES
  174. ELSEIF (IPT7.ITYPEL.EQ.25) THEN
  175. INOU(ISOUS)=IPT6
  176. DO 210 J=1,NBELEM
  177. I1=IPT7.NUM(1,J)
  178. I2=IPT7.NUM(2,J)
  179. I3=IPT7.NUM(3,J)
  180. I4=IPT7.NUM(4,J)
  181. I5=IPT7.NUM(5,J)
  182. CALL DEMCH1(I1,I2,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  183. IPT6.NUM(1,J)=I1
  184. IPT6.NUM(2,J)=I6
  185. IPT6.NUM(3,J)=I2
  186. CALL DEMCH1(I2,I3,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  187. IPT6.NUM(4,J)=I6
  188. IPT6.NUM(5,J)=I3
  189. CALL DEMCH1(I3,I4,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  190. IPT6.NUM(6,J)=I6
  191. IPT6.NUM(7,J)=I4
  192. CALL DEMCH1(I4,I1,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  193. IPT6.NUM(8,J)=I6
  194. CALL DEMCH1(I1,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  195. IPT6.NUM(9,J)=I6
  196. CALL DEMCH1(I2,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  197. IPT6.NUM(10,J)=I6
  198. CALL DEMCH1(I3,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  199. IPT6.NUM(11,J)=I6
  200. CALL DEMCH1(I4,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  201. IPT6.NUM(12,J)=I6
  202. IPT6.NUM(13,J)=I5
  203. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  204. 210 CONTINUE
  205. * CAS DES PRISMES
  206. ELSEIF (IPT7.ITYPEL.EQ.16) THEN
  207. INOU(ISOUS)=IPT6
  208. DO 220 J=1,NBELEM
  209. I1=IPT7.NUM(1,J)
  210. I2=IPT7.NUM(2,J)
  211. I3=IPT7.NUM(3,J)
  212. I4=IPT7.NUM(4,J)
  213. I5=IPT7.NUM(5,J)
  214. I6=IPT7.NUM(6,J)
  215. CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  216. IPT6.NUM(1,J)=I1
  217. IPT6.NUM(2,J)=I7
  218. IPT6.NUM(3,J)=I2
  219. CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  220. IPT6.NUM(4,J)=I7
  221. IPT6.NUM(5,J)=I3
  222. CALL DEMCH1(I3,I1,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  223. IPT6.NUM(6,J)=I7
  224. CALL DEMCH1(I1,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  225. IPT6.NUM(7,J)=I7
  226. CALL DEMCH1(I2,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  227. IPT6.NUM(8,J)=I7
  228. CALL DEMCH1(I3,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  229. IPT6.NUM(9,J)=I7
  230. CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  231. IPT6.NUM(10,J)=I4
  232. IPT6.NUM(11,J)=I7
  233. IPT6.NUM(12,J)=I5
  234. CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  235. IPT6.NUM(13,J)=I7
  236. IPT6.NUM(14,J)=I6
  237. CALL DEMCH1(I6,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  238. IPT6.NUM(15,J)=I7
  239. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  240. 220 CONTINUE
  241. * CAS DES CUBES
  242. ELSEIF (IPT7.ITYPEL.EQ.14) THEN
  243. INOU(ISOUS)=IPT6
  244. DO 230 J=1,NBELEM
  245. I1=IPT7.NUM(1,J)
  246. I2=IPT7.NUM(2,J)
  247. I3=IPT7.NUM(3,J)
  248. I4=IPT7.NUM(4,J)
  249. I5=IPT7.NUM(5,J)
  250. I6=IPT7.NUM(6,J)
  251. I7=IPT7.NUM(7,J)
  252. I8=IPT7.NUM(8,J)
  253. CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  254. IPT6.NUM(1,J)=I1
  255. IPT6.NUM(2,J)=I9
  256. IPT6.NUM(3,J)=I2
  257. CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  258. IPT6.NUM(4,J)=I9
  259. IPT6.NUM(5,J)=I3
  260. CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  261. IPT6.NUM(6,J)=I9
  262. IPT6.NUM(7,J)=I4
  263. CALL DEMCH1(I4,I1,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  264. IPT6.NUM(8,J)=I9
  265. CALL DEMCH1(I1,I5,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  266. IPT6.NUM(9,J)=I9
  267. CALL DEMCH1(I2,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  268. IPT6.NUM(10,J)=I9
  269. CALL DEMCH1(I3,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  270. IPT6.NUM(11,J)=I9
  271. CALL DEMCH1(I4,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  272. IPT6.NUM(12,J)=I9
  273. CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  274. IPT6.NUM(13,J)=I5
  275. IPT6.NUM(14,J)=I9
  276. IPT6.NUM(15,J)=I6
  277. CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  278. IPT6.NUM(16,J)=I9
  279. IPT6.NUM(17,J)=I7
  280. CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  281. IPT6.NUM(18,J)=I9
  282. IPT6.NUM(19,J)=I8
  283. CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  284. IPT6.NUM(20,J)=I9
  285. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  286. 230 CONTINUE
  287. * CAS DES SEG2
  288. ELSEIF (IPT7.ITYPEL.EQ.2) THEN
  289. INOU(ISOUS)=IPT6
  290. DO 240 J=1,NBELEM
  291. I1=IPT7.NUM(1,J)
  292. I2=IPT7.NUM(2,J)
  293. CALL DEMCH1(I1,I2,I3,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  294. IPT6.NUM(1,J)=I1
  295. IPT6.NUM(2,J)=I3
  296. IPT6.NUM(3,J)=I2
  297. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  298. 240 CONTINUE
  299. * CAS DES TRI3 ou des tri4
  300. ELSEIF (IPT7.ITYPEL.EQ.4.OR.IPT7.ITYPEL.EQ.5) THEN
  301. INOU(ISOUS)=IPT6
  302. DO 250 J=1,NBELEM
  303. I1=IPT7.NUM(1,J)
  304. I2=IPT7.NUM(2,J)
  305. I3=IPT7.NUM(3,J)
  306. CALL DEMCH1(I1,I2,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  307. IPT6.NUM(1,J)=I1
  308. IPT6.NUM(2,J)=I4
  309. IPT6.NUM(3,J)=I2
  310. CALL DEMCH1(I2,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  311. IPT6.NUM(4,J)=I4
  312. IPT6.NUM(5,J)=I3
  313. CALL DEMCH1(I1,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  314. IPT6.NUM(6,J)=I4
  315. IF(IPT7.ITYPEL.EQ.5)IPT6.NUM(7,J)=IPT7.NUM(4,J)
  316. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  317. 250 CONTINUE
  318. * CAS DES QUA4 ou des QUA5
  319. ELSEIF (IPT7.ITYPEL.EQ.8.OR.IPT7.ITYPEL.EQ.9) THEN
  320. INOU(ISOUS)=IPT6
  321. DO 260 J=1,NBELEM
  322. I1=IPT7.NUM(1,J)
  323. I2=IPT7.NUM(2,J)
  324. I3=IPT7.NUM(3,J)
  325. I4=IPT7.NUM(4,J)
  326. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  327. IPT6.NUM(1,J)=I1
  328. IPT6.NUM(2,J)=I5
  329. IPT6.NUM(3,J)=I2
  330. CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  331. IPT6.NUM(4,J)=I5
  332. IPT6.NUM(5,J)=I3
  333. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  334. IPT6.NUM(6,J)=I5
  335. IPT6.NUM(7,J)=I4
  336. CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  337. IPT6.NUM(8,J)=I5
  338. IF(IPT7.ITYPEL.EQ.9)IPT6.NUM(9,J)=IPT7.NUM(5,J)
  339. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  340. 260 CONTINUE
  341. * CAS des RAC2
  342. ELSEIF (IPT7.ITYPEL.EQ.12) THEN
  343. INOU(ISOUS)=IPT6
  344. DO 270 J=1,NBELEM
  345. I1=IPT7.NUM(1,J)
  346. I2=IPT7.NUM(2,J)
  347. I3=IPT7.NUM(3,J)
  348. I4=IPT7.NUM(4,J)
  349. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  350. IPT6.NUM(1,J)=I1
  351. IPT6.NUM(2,J)=I5
  352. IPT6.NUM(3,J)=I2
  353. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  354. IPT6.NUM(4,J)=I3
  355. IPT6.NUM(5,J)=I5
  356. IPT6.NUM(5,J)=I4
  357. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  358. 270 CONTINUE
  359. * CAS des lia3
  360. ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  361. INOU(ISOUS)=IPT6
  362. DO 280 J=1,NBELEM
  363. I1=IPT7.NUM(1,J)
  364. I2=IPT7.NUM(2,J)
  365. I3=IPT7.NUM(3,J)
  366. I4=IPT7.NUM(4,J)
  367. I5=IPT7.NUM(5,J)
  368. I6=IPT7.NUM(6,J)
  369. CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  370. IPT6.NUM(1,J)=I1
  371. IPT6.NUM(2,J)=I7
  372. IPT6.NUM(3,J)=I2
  373. CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  374. IPT6.NUM(4,J)=I7
  375. IPT6.NUM(5,J)=I3
  376. CALL DEMCH1(I1,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  377. IPT6.NUM(6,J)=I7
  378. CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  379. IPT6.NUM(7,J)=I4
  380. IPT6.NUM(8,J)=I7
  381. IPT6.NUM(9,J)=I5
  382. CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  383. IPT6.NUM(10,J)=I7
  384. IPT6.NUM(11,J)=I5
  385. CALL DEMCH1(I4,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  386. IPT6.NUM(12,J)=I7
  387. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  388. 280 CONTINUE
  389. * CAS des lia4
  390. ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  391. INOU(ISOUS)=IPT6
  392. DO 290 J=1,NBELEM
  393. I1=IPT7.NUM(1,J)
  394. I2=IPT7.NUM(2,J)
  395. I3=IPT7.NUM(3,J)
  396. I4=IPT7.NUM(4,J)
  397. I5=IPT7.NUM(5,J)
  398. I6=IPT7.NUM(6,J)
  399. I7=IPT7.NUM(7,J)
  400. I8=IPT7.NUM(8,J)
  401. CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  402. IPT6.NUM(1,J)=I1
  403. IPT6.NUM(2,J)=I9
  404. IPT6.NUM(3,J)=I2
  405. CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  406. IPT6.NUM(4,J)=I9
  407. IPT6.NUM(5,J)=I3
  408. CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  409. IPT6.NUM(6,J)=I9
  410. IPT6.NUM(7,J)=I4
  411. CALL DEMCH1(I1,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  412. IPT6.NUM(8,J)=I9
  413. CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  414. IPT6.NUM(9,J)=I5
  415. IPT6.NUM(10,J)=I9
  416. IPT6.NUM(11,J)=I6
  417. CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  418. IPT6.NUM(12,J)=I9
  419. IPT6.NUM(13,J)=I7
  420. CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  421. IPT6.NUM(14,J)=I9
  422. IPT6.NUM(15,J)=I8
  423. CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  424. IPT6.NUM(16,J)=I9
  425. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  426. 290 CONTINUE
  427. ENDIF
  428. 101 CONTINUE
  429. 100 CONTINUE
  430. SEGSUP KONFIN,KONMIL,KONSUI,KONPOS
  431. * on fusionne les sous parties
  432. II=INOU(/1)
  433. IRETOU=INOU(1)
  434. IF(II.EQ.1) GO TO 15
  435. DO 16 J=2,II
  436. INN=INOU(J)
  437. ltelq=.false.
  438. CALL FUSE( IRETOU,INN,IPT5,ltelq)
  439. IRETOU=IPT5
  440. 16 CONTINUE
  441. 15 CONTINUE
  442. MELEME=IRETOU
  443. END
  444.  
  445.  
  446.  

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