Télécharger demcha.eso

Retour à la liste

Numérotation des lignes :

  1. C DEMCHA SOURCE BP208322 16/11/18 21:16:19 9177
  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.EQ.0) THEN
  88. SEGDES IPT7
  89. ELSE
  90. SEGSUP IPT7
  91. ENDIF
  92. 60 CONTINUE
  93. SEGDES IPT8
  94. * MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire
  95. * SG 2016/07/21 et/ou des QUAF (dans ce dernier cas, il suffit
  96. * d'oublier les noeuds au centre des faces et de l'element)
  97.  
  98. IPT7=MELEME
  99. SEGACT MELEME
  100. NBSOU7=LISOUS(/1)
  101. NBSOUS=NBSOU7
  102. NBS = MAX(1,NBSOU7)
  103. SEGINI INOU
  104. NBREF=0
  105. NBELEM=0
  106. NBNN=0
  107. DO 100 ISOUS=1,MAX(1,NBSOU7)
  108. IF (NBSOU7.NE.0) IPT7=LISOUS(ISOUS)
  109. SEGACT IPT7
  110. INOU(ISOUS)=IPT7
  111. NBELEM=IPT7.NUM(/2)
  112. ITY=IPT7.ITYPEL
  113. * l'element est-il un quadratique fluide (quaf) ?
  114. iquaf=0
  115. do i=1,nquaf
  116. if (ity.eq.itquaf(i)) then
  117. iquaf=i
  118. goto 666
  119. endif
  120. enddo
  121. 666 continue
  122. * oui, c'est un quaf, on ne garde que les noeuds quadratiques
  123. * "normaux" (par chance de la definition des quaf, ce sont les n premiers)
  124. if (iquaf.ne.0) then
  125. itype=itquad(iquaf)
  126. NBNN=NBNNE(ITYPE)
  127. NBSOUS=0
  128. NBREF=0
  129. SEGINI IPT6
  130. IPT6.ITYPEL=ITYPE
  131. INOU(ISOUS)=IPT6
  132. DO J=1,NBELEM
  133. DO I=1,NBNN
  134. IPT6.NUM(I,J)=IPT7.NUM(I,J)
  135. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  136. ENDDO
  137. ENDDO
  138. goto 101
  139. endif
  140. ITYPE=IPT7.ITYPEL+1
  141. IF(IPT7.ITYPEL.EQ.4 . OR. IPT7.ITYPEL.EQ.5. OR .
  142. #IPT7.ITYPEL.EQ.8 . OR. IPT7.ITYPEL.EQ.9. OR.
  143. #IPT7.ITYPEL.EQ.18 . OR. IPT7.ITYPEL.EQ.19) ITYPE=ITYPE+1
  144. NBNN=NBNNE(ITYPE)
  145. NBSOUS=0
  146. NBREF=0
  147. SEGINI IPT6
  148. IPT6.ITYPEL=ITYPE
  149. * IF (NBSOU7.NE.0) IPT1.LISOUS(ISOUS)=IPT6
  150. * CAS DES TETRAEDRES
  151. IF (IPT7.ITYPEL.EQ.23) THEN
  152. INOU(ISOUS)=IPT6
  153. DO 200 J=1,NBELEM
  154. I1=IPT7.NUM(1,J)
  155. I2=IPT7.NUM(2,J)
  156. I3=IPT7.NUM(3,J)
  157. I4=IPT7.NUM(4,J)
  158. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  159. IPT6.NUM(1,J)=I1
  160. IPT6.NUM(2,J)=I5
  161. IPT6.NUM(3,J)=I2
  162. CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  163. IPT6.NUM(4,J)=I5
  164. IPT6.NUM(5,J)=I3
  165. CALL DEMCH1(I3,I1,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  166. IPT6.NUM(6,J)=I5
  167. CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  168. IPT6.NUM(7,J)=I5
  169. CALL DEMCH1(I2,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  170. IPT6.NUM(8,J)=I5
  171. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  172. IPT6.NUM(9,J)=I5
  173. IPT6.NUM(10,J)=I4
  174. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  175. 200 CONTINUE
  176. * CAS DES PYRAMIDES
  177. ELSEIF (IPT7.ITYPEL.EQ.25) THEN
  178. INOU(ISOUS)=IPT6
  179. DO 210 J=1,NBELEM
  180. I1=IPT7.NUM(1,J)
  181. I2=IPT7.NUM(2,J)
  182. I3=IPT7.NUM(3,J)
  183. I4=IPT7.NUM(4,J)
  184. I5=IPT7.NUM(5,J)
  185. CALL DEMCH1(I1,I2,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  186. IPT6.NUM(1,J)=I1
  187. IPT6.NUM(2,J)=I6
  188. IPT6.NUM(3,J)=I2
  189. CALL DEMCH1(I2,I3,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  190. IPT6.NUM(4,J)=I6
  191. IPT6.NUM(5,J)=I3
  192. CALL DEMCH1(I3,I4,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  193. IPT6.NUM(6,J)=I6
  194. IPT6.NUM(7,J)=I4
  195. CALL DEMCH1(I4,I1,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  196. IPT6.NUM(8,J)=I6
  197. CALL DEMCH1(I1,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  198. IPT6.NUM(9,J)=I6
  199. CALL DEMCH1(I2,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  200. IPT6.NUM(10,J)=I6
  201. CALL DEMCH1(I3,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  202. IPT6.NUM(11,J)=I6
  203. CALL DEMCH1(I4,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  204. IPT6.NUM(12,J)=I6
  205. IPT6.NUM(13,J)=I5
  206. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  207. 210 CONTINUE
  208. * CAS DES PRISMES
  209. ELSEIF (IPT7.ITYPEL.EQ.16) THEN
  210. INOU(ISOUS)=IPT6
  211. DO 220 J=1,NBELEM
  212. I1=IPT7.NUM(1,J)
  213. I2=IPT7.NUM(2,J)
  214. I3=IPT7.NUM(3,J)
  215. I4=IPT7.NUM(4,J)
  216. I5=IPT7.NUM(5,J)
  217. I6=IPT7.NUM(6,J)
  218. CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  219. IPT6.NUM(1,J)=I1
  220. IPT6.NUM(2,J)=I7
  221. IPT6.NUM(3,J)=I2
  222. CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  223. IPT6.NUM(4,J)=I7
  224. IPT6.NUM(5,J)=I3
  225. CALL DEMCH1(I3,I1,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  226. IPT6.NUM(6,J)=I7
  227. CALL DEMCH1(I1,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  228. IPT6.NUM(7,J)=I7
  229. CALL DEMCH1(I2,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  230. IPT6.NUM(8,J)=I7
  231. CALL DEMCH1(I3,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  232. IPT6.NUM(9,J)=I7
  233. CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  234. IPT6.NUM(10,J)=I4
  235. IPT6.NUM(11,J)=I7
  236. IPT6.NUM(12,J)=I5
  237. CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  238. IPT6.NUM(13,J)=I7
  239. IPT6.NUM(14,J)=I6
  240. CALL DEMCH1(I6,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  241. IPT6.NUM(15,J)=I7
  242. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  243. 220 CONTINUE
  244. * CAS DES CUBES
  245. ELSEIF (IPT7.ITYPEL.EQ.14) THEN
  246. INOU(ISOUS)=IPT6
  247. DO 230 J=1,NBELEM
  248. I1=IPT7.NUM(1,J)
  249. I2=IPT7.NUM(2,J)
  250. I3=IPT7.NUM(3,J)
  251. I4=IPT7.NUM(4,J)
  252. I5=IPT7.NUM(5,J)
  253. I6=IPT7.NUM(6,J)
  254. I7=IPT7.NUM(7,J)
  255. I8=IPT7.NUM(8,J)
  256. CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  257. IPT6.NUM(1,J)=I1
  258. IPT6.NUM(2,J)=I9
  259. IPT6.NUM(3,J)=I2
  260. CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  261. IPT6.NUM(4,J)=I9
  262. IPT6.NUM(5,J)=I3
  263. CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  264. IPT6.NUM(6,J)=I9
  265. IPT6.NUM(7,J)=I4
  266. CALL DEMCH1(I4,I1,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  267. IPT6.NUM(8,J)=I9
  268. CALL DEMCH1(I1,I5,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  269. IPT6.NUM(9,J)=I9
  270. CALL DEMCH1(I2,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  271. IPT6.NUM(10,J)=I9
  272. CALL DEMCH1(I3,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  273. IPT6.NUM(11,J)=I9
  274. CALL DEMCH1(I4,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  275. IPT6.NUM(12,J)=I9
  276. CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  277. IPT6.NUM(13,J)=I5
  278. IPT6.NUM(14,J)=I9
  279. IPT6.NUM(15,J)=I6
  280. CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  281. IPT6.NUM(16,J)=I9
  282. IPT6.NUM(17,J)=I7
  283. CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  284. IPT6.NUM(18,J)=I9
  285. IPT6.NUM(19,J)=I8
  286. CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  287. IPT6.NUM(20,J)=I9
  288. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  289. 230 CONTINUE
  290. * CAS DES SEG2
  291. ELSEIF (IPT7.ITYPEL.EQ.2) THEN
  292. INOU(ISOUS)=IPT6
  293. DO 240 J=1,NBELEM
  294. I1=IPT7.NUM(1,J)
  295. I2=IPT7.NUM(2,J)
  296. CALL DEMCH1(I1,I2,I3,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  297. IPT6.NUM(1,J)=I1
  298. IPT6.NUM(2,J)=I3
  299. IPT6.NUM(3,J)=I2
  300. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  301. 240 CONTINUE
  302. * CAS DES TRI3 ou des tri4
  303. ELSEIF (IPT7.ITYPEL.EQ.4.OR.IPT7.ITYPEL.EQ.5) THEN
  304. INOU(ISOUS)=IPT6
  305. DO 250 J=1,NBELEM
  306. I1=IPT7.NUM(1,J)
  307. I2=IPT7.NUM(2,J)
  308. I3=IPT7.NUM(3,J)
  309. CALL DEMCH1(I1,I2,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  310. IPT6.NUM(1,J)=I1
  311. IPT6.NUM(2,J)=I4
  312. IPT6.NUM(3,J)=I2
  313. CALL DEMCH1(I2,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  314. IPT6.NUM(4,J)=I4
  315. IPT6.NUM(5,J)=I3
  316. CALL DEMCH1(I1,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  317. IPT6.NUM(6,J)=I4
  318. IF(IPT7.ITYPEL.EQ.5)IPT6.NUM(7,J)=IPT7.NUM(4,J)
  319. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  320. 250 CONTINUE
  321. * CAS DES QUA4 ou des QUA5
  322. ELSEIF (IPT7.ITYPEL.EQ.8.OR.IPT7.ITYPEL.EQ.9) THEN
  323. INOU(ISOUS)=IPT6
  324. DO 260 J=1,NBELEM
  325. I1=IPT7.NUM(1,J)
  326. I2=IPT7.NUM(2,J)
  327. I3=IPT7.NUM(3,J)
  328. I4=IPT7.NUM(4,J)
  329. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  330. IPT6.NUM(1,J)=I1
  331. IPT6.NUM(2,J)=I5
  332. IPT6.NUM(3,J)=I2
  333. CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  334. IPT6.NUM(4,J)=I5
  335. IPT6.NUM(5,J)=I3
  336. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  337. IPT6.NUM(6,J)=I5
  338. IPT6.NUM(7,J)=I4
  339. CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  340. IPT6.NUM(8,J)=I5
  341. IF(IPT7.ITYPEL.EQ.9)IPT6.NUM(9,J)=IPT7.NUM(5,J)
  342. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  343. 260 CONTINUE
  344. * CAS des RAC2
  345. ELSEIF (IPT7.ITYPEL.EQ.12) THEN
  346. INOU(ISOUS)=IPT6
  347. DO 270 J=1,NBELEM
  348. I1=IPT7.NUM(1,J)
  349. I2=IPT7.NUM(2,J)
  350. I3=IPT7.NUM(3,J)
  351. I4=IPT7.NUM(4,J)
  352. CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  353. IPT6.NUM(1,J)=I1
  354. IPT6.NUM(2,J)=I5
  355. IPT6.NUM(3,J)=I2
  356. CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  357. IPT6.NUM(4,J)=I3
  358. IPT6.NUM(5,J)=I5
  359. IPT6.NUM(5,J)=I4
  360. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  361. 270 CONTINUE
  362. * CAS des lia3
  363. ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  364. INOU(ISOUS)=IPT6
  365. DO 280 J=1,NBELEM
  366. I1=IPT7.NUM(1,J)
  367. I2=IPT7.NUM(2,J)
  368. I3=IPT7.NUM(3,J)
  369. I4=IPT7.NUM(4,J)
  370. I5=IPT7.NUM(5,J)
  371. I6=IPT7.NUM(6,J)
  372. CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  373. IPT6.NUM(1,J)=I1
  374. IPT6.NUM(2,J)=I7
  375. IPT6.NUM(3,J)=I2
  376. CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  377. IPT6.NUM(4,J)=I7
  378. IPT6.NUM(5,J)=I3
  379. CALL DEMCH1(I1,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  380. IPT6.NUM(6,J)=I7
  381. CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  382. IPT6.NUM(7,J)=I4
  383. IPT6.NUM(8,J)=I7
  384. IPT6.NUM(9,J)=I5
  385. CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  386. IPT6.NUM(10,J)=I7
  387. IPT6.NUM(11,J)=I5
  388. CALL DEMCH1(I4,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  389. IPT6.NUM(12,J)=I7
  390. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  391. 280 CONTINUE
  392. * CAS des lia4
  393. ELSEIF (IPT7.ITYPEL.EQ.18) THEN
  394. INOU(ISOUS)=IPT6
  395. DO 290 J=1,NBELEM
  396. I1=IPT7.NUM(1,J)
  397. I2=IPT7.NUM(2,J)
  398. I3=IPT7.NUM(3,J)
  399. I4=IPT7.NUM(4,J)
  400. I5=IPT7.NUM(5,J)
  401. I6=IPT7.NUM(6,J)
  402. I7=IPT7.NUM(7,J)
  403. I8=IPT7.NUM(8,J)
  404. CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  405. IPT6.NUM(1,J)=I1
  406. IPT6.NUM(2,J)=I9
  407. IPT6.NUM(3,J)=I2
  408. CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  409. IPT6.NUM(4,J)=I9
  410. IPT6.NUM(5,J)=I3
  411. CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  412. IPT6.NUM(6,J)=I9
  413. IPT6.NUM(7,J)=I4
  414. CALL DEMCH1(I1,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  415. IPT6.NUM(8,J)=I9
  416. CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  417. IPT6.NUM(9,J)=I5
  418. IPT6.NUM(10,J)=I9
  419. IPT6.NUM(11,J)=I6
  420. CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  421. IPT6.NUM(12,J)=I9
  422. IPT6.NUM(13,J)=I7
  423. CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  424. IPT6.NUM(14,J)=I9
  425. IPT6.NUM(15,J)=I8
  426. CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS)
  427. IPT6.NUM(16,J)=I9
  428. IPT6.ICOLOR(J)=IPT7.ICOLOR(J)
  429. 290 CONTINUE
  430. ENDIF
  431. 101 CONTINUE
  432. SEGDES IPT7
  433. SEGDES IPT6
  434. 100 CONTINUE
  435. SEGSUP KONFIN,KONMIL,KONSUI,KONPOS
  436. * on fusionne les sous parties
  437. SEGDES MELEME
  438. II=INOU(/1)
  439. IRETOU=INOU(1)
  440. IF(II.EQ.1) GO TO 15
  441. DO 16 J=2,II
  442. INN=INOU(J)
  443. ltelq=.false.
  444. CALL FUSE( IRETOU,INN,IPT5,ltelq)
  445. IRETOU=IPT5
  446. 16 CONTINUE
  447. 15 CONTINUE
  448. MELEME=IRETOU
  449. END
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  

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