Télécharger mailvoro.procedur

Retour à la liste

Numérotation des lignes :

  1. * MAILVORO PROCEDUR FD218221 15/12/17 21:15:12 8757
  2. *----------------------------------------------------------------------*
  3. * Procedure de maillage volumique d'une partition de voronoi *
  4. *----------------------------------------------------------------------*
  5. *
  6. * ENTREE :
  7. *---------
  8. * - TAB1 : TABLE ISSUE DE L'OPERATEUR VORO
  9. * - ENV0 : ENVELOPPE DE LA PARTITION
  10. * - NBDIV0 : NOMBRE D'ELEMENTS CIBLE PAR DIAMETRE DE CELLULE
  11. * - COEF0 : PERMET DE CALCULER CRIT1 = COEF0 * HCEL
  12. * AVEC, POUR CHAQUE CELLULE :
  13. * - HCEL := LE PAS DE MAILLAGE CIBLE CHAQUE CELLULE
  14. * - CRIT1 := LE CRITERE DE SELECTION DES PETITES ARETES
  15. *
  16. * SORTIE :
  17. *---------
  18. * - MTRIA1 = TABLE DES DONNEES DU MAILLAGE VOLUMIQUE
  19. *----------------------------------------------------------------------*
  20. DEBP MAILVORO TAB1*'TABLE' ENV0*'MAILLAGE' NBDIV/'ENTIER'
  21. COEF1/'FLOTTANT' MO1/'MOT';
  22. IDIM = VALE 'DIME' ;
  23. *======================================================================*
  24. * Initialisation *
  25. *======================================================================*
  26. SI (NON(EXIS NBDIV));
  27. NBDIV = 4;
  28. FINS;
  29. *
  30. SI (NON(EXIS COEF1));
  31. COEF1 = 1./3;
  32. FINS;
  33. *
  34. TABI1 = INDE (TAB1 .CELL);
  35. NBCEL0 = DIME TABI1;
  36. IA = INDE (TAB1 .ARTS);
  37. *
  38. SI (IDIM EGA 3);
  39. ARE0 = CHAN LIGN ENV0;
  40. MENV0 = TRIA ENV0;
  41. SINO;
  42. ARE0 = ENV0;
  43. MENV0 = SURF ENV0;
  44. FINS;
  45. *
  46. VENV0 = MESU MENV0;
  47. MCELREF = (VENV0/(NBCEL0));
  48. TDENSC = TABLE;
  49. TDENSS = TABLE;
  50. *
  51. *======================================================================*
  52. * Determiner la taille de maille cible des cellules *
  53. *======================================================================*
  54. *
  55. REPE B0 (DIME TABI1);
  56. P0 = TABI1 . (&B0);
  57. OPTI 'ERRE' 'IGNO' ;
  58. MAILCEL = TRIA (CHAN POI1 (TAB1 .CELL.P0 .VISU));
  59. OPTI 'ERRE' 'NORM' ;
  60. SI (NON(EXIS MAILCEL));
  61. MCEL = MCELREF;
  62. SINO;
  63. MCEL = MESU (MAILCEL);
  64. FINS;
  65. *
  66. SI (MCEL > MCELREF);
  67. HCEL = (MCEL**(1./IDIM)) / NBDIV;
  68. TDENSC . P0 = HCEL;
  69. SINO;
  70. TDENSC . P0 = ((MCELREF**(1./IDIM)) / NBDIV);
  71. FINS;
  72. FIN B0;
  73. *
  74. *=====================================================================*
  75. * Tables des correspondances
  76. *=====================================================================*
  77. SI (IDIM EGA 3);
  78. * table de correspondance fac ---> cel
  79. TFC = TABLE;
  80. IC = INDE (TAB1.CELL);
  81. REPE B0 (DIME IC);
  82. P0 = IC . &B0;
  83. LFAC0 = TAB1.CELL.P0 .FACS;
  84. REPE B01 (DIME LFAC0);
  85. NFAC01 = EXTR LFAC0 &B01;
  86. SI (NON(EXIS TFC NFAC01));
  87. TFC . NFAC01 = MANU POI1 P0;
  88. SINO;
  89. SI (NON (DANS P0 (TFC.NFAC01)));
  90. TFC . NFAC01 = (TFC . NFAC01) ET P0;
  91. FINS;
  92. FINS;
  93. FIN B01;
  94. FIN B0;
  95. * table correspondance art ---> fac et art ---> cel
  96. TAFC = TABL;
  97. IF = INDE (TAB1.FACS);
  98. REPE B0 (DIME IF);
  99. NFAC0 = IF . &B0;
  100. LART0 = TAB1.FACS.NFAC0 .ARTS;
  101. REPE B01 (DIME LART0);
  102. NART01 = EXTR LART0 &B01;
  103. SI (NON(EXIS TAFC NART01));
  104. TAFC . NART01 = TABL;
  105. TAFC . NART01 . 'FACS' = LECT;
  106. TAFC . NART01 . 'FACS' = TAFC . NART01 . 'FACS' ET NFAC0;
  107. TAFC . NART01 . 'CELL' = TFC . NFAC0;
  108. SINO;
  109. SI (NON(EXIS (TAFC . NART01 . 'FACS') NFAC0));
  110. TAFC . NART01 . 'FACS' = (TAFC . NART01 . 'FACS') ET NFAC0;
  111. FINS;
  112. REPE B001 (NBNO (TFC.NFAC0));
  113. P001 = (TFC.NFAC0) POIN &B001;
  114. SI (NON (DANS P001 (TAFC.NART01 .'CELL')));
  115. TAFC.NART01 .'CELL' = (TAFC.NART01 .'CELL') ET P001;
  116. FINS;
  117. FIN B001;
  118. FINS;
  119. FIN B01;
  120. FIN B0;
  121. * Table correspondance sommet ---> art
  122. TSA = TABL;
  123. LARTINI = LECT;
  124. REPE B0 (DIME IA);
  125. NART0 = IA . &B0;
  126. LARTINI = LARTINI ET NART0;
  127. S1 = (TAB1. ARTS.NART0) POIN 1;
  128. S2 = (TAB1. ARTS.NART0) POIN 2;
  129. SMT = S1 ET S2;
  130. REPE B00 2;
  131. S0 = SMT POIN &B00;
  132. SI (NON(EXIS TSA S0));
  133. TSA . S0 = TABL;
  134. TSA . S0 . 'ARTS' = LECT;
  135. TSA . S0 . 'ARTS' = TSA . S0 . 'ARTS' ET NART0;
  136. TSA . S0 . 'FACS' = TAFC . NART0 . 'FACS';
  137. TSA . S0 . 'CELL' = TAFC . NART0 . 'CELL';
  138. SINO;
  139. SI (NON(EXIS (TSA.S0 .'ARTS') NART0));
  140. TSA . S0 . 'ARTS' = TSA . S0 . 'ARTS' ET NART0;
  141. FINS;
  142. REPE B01 (DIME (TAFC . NART0 . 'FACS'));
  143. NFAC01 = EXTR (TAFC . NART0 . 'FACS') &B01;
  144. SI (NON(EXIS (TSA . S0 . 'FACS') NFAC01));
  145. TSA . S0 . 'FACS' = (TSA . S0 . 'FACS') ET NFAC01;
  146. FINS;
  147. FIN B01;
  148. *
  149. REPE B02 (NBNO (TAFC . NART0 . 'CELL'));
  150. P02 = (TAFC . NART0 . 'CELL') POIN &B02;
  151. SI (NON (DANS P02 (TSA . S0 . 'CELL')));
  152. TSA . S0 . 'CELL' = (TSA . S0 . 'CELL') ET P02;
  153. FINS;
  154. FIN B02;
  155. FINS;
  156. FIN B00;
  157. FIN B0;
  158. *
  159. FINS;
  160. *
  161. SI (IDIM EGA 2);
  162. * table de correspondance ART ---> cel
  163. TAC = TABLE;
  164. IC = INDE (TAB1.CELL);
  165. *
  166. REPE B0 (DIME IC);
  167. P0 = IC . &B0;
  168. LART0 = TAB1.CELL.P0 .ARTS;
  169. REPE B01 (DIME LART0);
  170. NART01 = EXTR LART0 &B01;
  171. SI (NON(EXIS TAC NART01));
  172. TAC . NART01 = MANU POI1 P0;
  173. SINO;
  174. SI (NON (DANS P0 (TAC.NART01)));
  175. TAC . NART01 = (TAC . NART01) ET P0;
  176. FINS;
  177. FINS;
  178. FIN B01;
  179. FIN B0;
  180. * Table correspondance sommet ---> art
  181. TSA = TABL;
  182. LARTINI = LECT;
  183. REPE B0 (DIME IA);
  184. NART0 = IA . &B0;
  185. LARTINI = LARTINI ET NART0;
  186. S1 = (TAB1. ARTS.NART0) POIN 1;
  187. S2 = (TAB1. ARTS.NART0) POIN 2;
  188. SMT = S1 ET S2;
  189. REPE B00 2;
  190. S0 = SMT POIN &B00;
  191. SI (NON(EXIS TSA S0));
  192. TSA . S0 = TABL;
  193. TSA . S0 . 'ARTS' = LECT;
  194. TSA . S0 . 'ARTS' = TSA . S0 . 'ARTS' ET NART0;
  195. TSA . S0 . 'CELL' = TAC . NART0;
  196. SINO;
  197. *
  198. SI (NON(EXIS (TSA.S0 .'ARTS') NART0));
  199. TSA . S0 . 'ARTS' = TSA . S0 . 'ARTS' ET NART0;
  200. FINS;
  201. *
  202. REPE B02 (NBNO (TAC . NART0));
  203. P02 = (TAC . NART0) POIN &B02;
  204. SI (NON (DANS P02 (TSA . S0 . 'CELL')));
  205. TSA . S0 . 'CELL' = (TSA . S0 . 'CELL') ET P02;
  206. FINS;
  207. FIN B02;
  208. *
  209. FINS;
  210. FIN B00;
  211. FIN B0;
  212. FINS;
  213. * Determiner les densites aux sommets
  214. ITSA = INDE TSA;
  215. REPE B0 (DIME TSA);
  216. S0 = ITSA . &B0;
  217. REPE B00 (NBNO (TSA . S0 . 'CELL'));
  218. P02 = (TSA . S0 . 'CELL') POIN &B00;
  219. SI (NON(EXIS TDENSS S0));
  220. TDENSS . S0 = TDENSC . P02;
  221. SINON;
  222. SI ((TDENSC . P02) < (TDENSS . S0));
  223. TDENSS . S0 = TDENSC . P02;
  224. FINS;
  225. FINS;
  226. FIN B00;
  227. FIN B0;
  228. *======================================================================*
  229. * ELIMINATION DES PETITES ARETES *
  230. *======================================================================*
  231. *
  232. TAB2 = TABLE;
  233. TAB2 . 'CELL' = TABLE;
  234. TAB2 . 'FACS' = TABLE;
  235. TAB2 . 'ARTS' = TABLE;
  236. *
  237. TSMT = TABLE;
  238. TANT = TABLE;
  239. *
  240. NBARTS = DIME IA;
  241. LART1 = LARTINI;
  242. LARTNEW = LECT;
  243. * Determiner les sommets sur l'enveloppe;
  244. SMT0 = CHAN POI1 (TAB1.VISU);
  245. SI (IDIM EGA 3);
  246. SMTIN = INCL SMT0 MENV0 'VOLU' 'STRI' 1E-400;
  247. SINO;
  248. SMTIN = INCL SMT0 MENV0 'STRI' 1E-400;
  249. FINS;
  250. SMTOUT = DIFF SMT0 SMTIN;
  251. OUBL SMT0; OUBL STMIN;
  252. *
  253. REPE B1 NBARTS;
  254. *
  255. NART1 = IA . &B1;
  256. ART01 = TAB1 .'ARTS'.NART1;
  257. * Verifier que ART111 n'est pas une arete de l'enveloppe
  258. TEST = ART01 INTE ARE0 NOVERIF;
  259. SI ((NBEL TEST) > 0);
  260. LARTNEW = LARTNEW ET NART1;
  261. OUBL TEST;
  262. ITER B1;
  263. FINS;
  264. OUBL TEST;
  265. *
  266. S1 = ART01 POIN 1; S2 = ART01 POIN 2;
  267. *
  268. SI (EXIS TSMT S1);
  269. SN1 = TSMT . S1;
  270. ANT1 = TANT . SN1;
  271. SINO;
  272. SN1 = S1;
  273. ANT1 = VIDE MAILLAGE/POI1;
  274. FINS;
  275. *
  276. SI (EXIS TSMT S2);
  277. SN2 = TSMT . S2;
  278. ANT2 = TANT . SN2;
  279. SINO;
  280. SN2 = S2;
  281. ANT2 = VIDE MAILLAGE/POI1;
  282. FINS;
  283. * Verifier que SN1 et SN2 ne sont pas confondus
  284. SI (SN1 EGA SN2 1.E-10);
  285. ITER B1;
  286. FINS;
  287. *
  288. ART1 = D 1 SN1 SN2;
  289. * Verifier que ART1 n'est pas une arete de l'enveloppe
  290. TEST = ART1 INTE ARE0 NOVERIF;
  291. SI ((NBEL TEST) > 0);
  292. SI (NON(EXIS LARTNEW NART1));
  293. LARTNEW = LARTNEW ET NART1;
  294. FINS;
  295. OUBL TEST;
  296. ITER B1;
  297. FINS;
  298. OUBL TEST;
  299. *
  300. CRIT1 = MINI (((TDENSS . SN1)*COEF1) ET ((TDENSS . SN2)*COEF1));
  301. SI ((MESU ART1) < CRIT1);
  302. * Determiner SM0 point de fusionnement de S1 et S2 *
  303. SI ((DANS SN1 SMTOUT) OU (DANS SN2 SMTOUT));
  304. SI (IDIM EGA 3);
  305. ENV0A = ARET ENV0 1;
  306. SINO;
  307. ENV0A = ENV0;
  308. FINS;
  309. TBOR = 'TABLE';
  310. PILE1 = 1 ET 2;
  311. *
  312. SI (IDIM EGA 3);
  313. 'REPE' B2 ('NBEL' ENV0);
  314. BORDI = ENV0 'ELEM' &B2;
  315. BORDIM = BORDI HOMO 1.0000001 (BARY BORDI);
  316. BORDIP = 'CHAN' 'POI1' BORDI;
  317. BORDIA = 'CHAN' LIGN BORDI;
  318. BORDIA = BORDIA INTE ENV0A NOVERIF;
  319. ****
  320. PILE0 = PILE1;
  321. 'REPE' B20 (DIME PILE0);
  322. S10 = ART1 POIN (EXTR PILE0 &B20);
  323. * Test appartenance de S10 a l'element BORDI
  324. TEST1 = 'INCLU' (MANU POI1 S10) BORDIM 'LARG' 'NOID';
  325. 'SI' ((NBNO TEST1) 'EGA' 1);
  326. N1 = ((BORDIP 'POIN' 1) 'MOIN' (BORDIP 'POIN' 3))
  327. PVEC ((BORDIP 'POIN' 2) 'MOIN' (BORDIP 'POIN' 3));
  328. PRJ1 = S10 'PROJ' 'CYLIN' N1
  329. 'PLAN' (BORDIP POIN 1) (BORDIP POIN 2) (BORDIP 'POIN' 3);
  330. D1 = 'NORME' (PRJ1 'MOINS' S10);
  331. 'SI' (D1 < 1.E-10);
  332. TEST3 = (MANU POI1 S10) INTE (CHAN POI1 BORDI) NOVERIF;
  333. * Test coincidence S10 avec sommets enveloppe *
  334. 'SI' ((NBNO TEST3) EGA 1);
  335. TBOR . (EXTR PILE0 &B20) = TEST3;
  336. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  337. PILE1 = ENLE PILE1 OUNUM;
  338. 'SI' ((DIME PILE1) EGA 0);
  339. QUIT B2;
  340. 'SINO';
  341. ITER B20;
  342. 'FINS';
  343. 'FINS';
  344. * Test appartenance S10 a une des aretes "vives" du plan considere *
  345. SI ((NBEL BORDIA) > 0);
  346. 'REPE' B200 (NBEL BORDIA);
  347. A100 = BORDIA ELEM &B200;
  348. V1 = (A100 POIN 1) MOIN S10; V2 = (A100 POIN 2) MOIN S10;
  349. TEST5 = (V1 PSCA V2)/((NORM V1)*(NORM V2));
  350. 'SI' ((ABS(TEST5 + 1.0)) < 1E-10);
  351. TBOR . (EXTR PILE0 &B20) = A100;
  352. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  353. PILE1 = ENLE PILE1 OUNUM;
  354. 'SI' ((DIME PILE1) EGA 0);
  355. QUIT B2;
  356. 'SINO';
  357. ITER B20;
  358. 'FINS';
  359. 'FINS';
  360. 'FIN' B200;
  361. FINS;
  362. * Les Tests precedents sont negatifs ==> S10 dans l'element BORDI *
  363. TBOR . (EXTR PILE0 &B20) = BORDI;
  364. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  365. PILE1 = ENLE PILE1 OUNUM;
  366. 'SI' ((DIME PILE1) EGA 0);
  367. QUIT B2;
  368. 'SINO';
  369. ITER B20;
  370. 'FINS';
  371. 'FINS';
  372. 'FINS';
  373. 'FIN' B20;
  374. **
  375. 'FIN' B2;
  376. FINS;
  377. *
  378. SI(EGA IDIM 2);
  379. 'REPE' B2 ('NBEL' ENV0);
  380. BORDI = ENV0 'ELEM' &B2;
  381. PB1 = BORDI POIN 1;PB2 = BORDI POIN 2;
  382. PILE0 = PILE1;
  383. 'REPE' B20 (DIME PILE0);
  384. S10 = ART1 POIN (EXTR PILE0 &B20);
  385. * Test coincidence S10 avec sommets enveloppe *
  386. SI (EGA S10 PB1 1E-10);
  387. TBOR . (EXTR PILE0 &B20) = MANU POI1 S10;
  388. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  389. PILE1 = ENLE PILE1 OUNUM;
  390. 'SI' ((DIME PILE1) EGA 0);
  391. QUIT B2;
  392. 'SINO';
  393. ITER B20;
  394. 'FINS';
  395. FINS;
  396. *
  397. SI (EGA S10 PB2 1E-10);
  398. TBOR . (EXTR PILE0 &B20) = MANU POI1 S10;
  399. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  400. PILE1 = ENLE PILE1 OUNUM;
  401. 'SI' ((DIME PILE1) EGA 0);
  402. QUIT B2;
  403. 'SINO';
  404. ITER B20;
  405. 'FINS';
  406. FINS;
  407. *
  408. V1 = PB1 MOIN S10; V2 = PB2 MOIN S10;
  409. * Test appartenance de S10 a l'element BORDI
  410. TEST5 = (V1 PSCA V2)/((NORM V1)*(NORM V2));
  411. 'SI' ((ABS(TEST5 + 1.0)) < (1E-04));
  412. TBOR . (EXTR PILE0 &B20) = BORDI;
  413. OUNUM = POSI (EXTR PILE0 &B20) DANS PILE1;
  414. PILE1 = ENLE PILE1 OUNUM;
  415. 'SI' ((DIME PILE1) EGA 0);
  416. QUIT B2;
  417. 'SINO';
  418. ITER B20;
  419. 'FINS';
  420. FINS;
  421. FIN B20;
  422. FIN B2;
  423. FINS;
  424. *
  425. REPE QIT0 1;
  426. *
  427. SI ((DIME TBOR) EGA 1);
  428. SM0 = ART1 POIN ((INDE TBOR) . 1);
  429. SMTOUT = SMTOUT ET SM0;
  430. QUIT QIT0;
  431. FINS;
  432. *
  433. SI ((DIME TBOR) EGA 2);
  434. INFO1 = NBNO (TBOR . 1);
  435. INFO2 = NBNO (TBOR . 2);
  436. *
  437. SI (INFO1 EGA INFO2);
  438. SI (info1 EGA 3);
  439. SI (EGA (TBOR . 1) (TBOR . 2));
  440. SM0 = 0.5*(SN1 'PLUS' SN2);
  441. SMTOUT = SMTOUT ET SM0;
  442. QUIT QIT0;
  443. SINO;
  444. CONT1 = CHAN POI1 (TBOR . 1);
  445. CONT2 = CHAN POI1 (TBOR . 2);
  446. INTC12 = CONT1 INTE CONT2;
  447. SI ((NBNO INTC12) EGA 2);
  448. * Determination de la projection de S1 sur INTC12
  449. PARK1 = INTC12 'POIN' 1;
  450. PARK2 = INTC12 'POIN' 2;
  451. PARK12 = PARK2 'MOIN' PARK1;
  452. NPARK12 = 'NORME' PARK12;
  453. VAL1 = (S1 'MOIN' PARK1) 'PSCAL' PARK12;
  454. VAL1 = VAL1 '/' ((NPARK12)**2);
  455. SM0 = PARK1 'PLUS' (VAL1 '*' (PARK12));
  456. SMTOUT = SMTOUT ET SM0;
  457. QUIT QIT0;
  458. SINO;
  459. SI ((NBNO INTC12) EGA 1);
  460. SM0 = INTC12 POIN 1;
  461. QUIT QIT0;
  462. SINO;
  463. ERREUR 5;
  464. FINS;
  465. FINS;
  466. FINS;
  467. SINO;
  468. TEST = (CHAN POI1 (TBOR . 1)) INTE (CHAN POI1 (TBOR . 2));
  469. SI ((NBNO TEST) EGA 2);
  470. SM0 = 0.5*(SN1 'PLUS' SN2);
  471. SMTOUT = SMTOUT ET SM0;
  472. QUIT QIT0;
  473. SINO;
  474. SM0 = TEST POIN 1;
  475. QUIT QIT0;
  476. FINS;
  477. *
  478. FINS;
  479. FINS;
  480. *
  481. 'SI' (INFO1 < INFO2);
  482. SM0 = SN1;
  483. SMTOUT = SMTOUT ET SM0;
  484. QUIT QIT0;
  485. 'SINO';
  486. SM0 = SN2;
  487. SMTOUT = SMTOUT ET SM0;
  488. QUIT QIT0;
  489. 'FINS';
  490. 'FINS';
  491. 'FIN' QIT0;
  492. SINO;
  493. SM0 = 0.5*(SN1 'PLUS' SN2);
  494. FINS;
  495. *
  496. SI (EXIS TSMT SM0);
  497. SM0 = TSMT.SM0;
  498. FINS;
  499. *
  500. SI (EXIS TSMT S1);
  501. REPE B11 (NBEL ANT1);
  502. TSMT . (ANT1 POIN &B11) = SM0;
  503. FIN B11;
  504. FINS;
  505. *
  506. SI (EXIS TSMT S2);
  507. REPE B11 (NBEL ANT2);
  508. TSMT . (ANT2 POIN &B11) = SM0;
  509. FIN B11;
  510. FINS;
  511. *
  512. TSMT . S1 = SM0; TSMT . S2 = SM0;
  513. TSMT. SN1 = SM0; TSMT. SN2 = SM0;
  514. TANT . SM0 = (S1 ET S2 ET ANT1 ET ANT2 ET SN1 ET SN2);
  515. *
  516. TDENSS . SM0 = CRIT1/COEF1;
  517. SINO;
  518. LARTNEW = LARTNEW ET NART1;
  519. FINS;
  520. MENAGE;
  521. FIN B1;
  522. *
  523. * Construir la nouvelle table des aretes
  524. REPE B2 (DIME LARTNEW);
  525. NART2 = EXTR LARTNEW &B2;
  526. ART2 = TAB1 .'ARTS'.NART2;
  527. S1 = ART2 POIN 1; S2 = ART2 POIN 2;
  528. SI (EXIS TSMT S1);
  529. SF1 = TSMT . S1;
  530. SINO;
  531. SF1 = S1;
  532. FINS;
  533. SI (EXIS TSMT S2);
  534. SF2 = TSMT . S2;
  535. SINO;
  536. SF2 = S2;
  537. FINS;
  538. *
  539. SI(NON(SF1 EGA SF2 1.E-10));
  540. TAB2 . 'ARTS'. NART2 = D 1 SF1 SF2;
  541. * MISE À JOUR DES DENSITES
  542. DIMA = MESU (TAB2 . 'ARTS'. NART2);
  543. TDENSS.SF1 = MINI((TDENSS.SF1) ET (1.3*DIMA));
  544. TDENSS.SF2 = MINI((TDENSS.SF2) ET (1.3*DIMA));
  545. FINS;
  546. FIN B2;
  547. *
  548. SI (IDIM EGA 3);
  549. * Creer la nouvelle table des faces
  550. SAVEARTB = TABLE;
  551. ITF = INDE (TAB1 . 'FACS');
  552. REPE B3 (DIME ITF);
  553. NFAC3 = ITF . &B3;
  554. LART3 = TAB1 . 'FACS' . NFAC3 . 'ARTS';
  555. LARTN = LECT;
  556. VISUN = 'VIDE' 'MAILLAGE'/SEG2;
  557. *
  558. REPE B31 (DIME LART3);
  559. NART31 = EXTR LART3 &B31;
  560. SI (EXIS (TAB2 .'ARTS') NART31);
  561. LARTN = LARTN ET NART31;
  562. VISUN = VISUN ET (TAB2 . 'ARTS' .NART31);
  563. FINS;
  564. FIN B31;
  565. *
  566. SI (DIME LARTN < 2);
  567. ITER B3;
  568. FINS;
  569. *
  570. SI ((DIME LARTN) EGA 2);
  571. NARTA = EXTR LARTN 1; NARTB = EXTR LARTN 2;
  572. SAVEARTB . NARTB = NARTA;
  573. ITER B3;
  574. FINS;
  575. TAB2 . 'FACS' . NFAC3 = TABLE;
  576. TAB2 . 'FACS' . NFAC3 . 'VISU' = VISUN;
  577. TAB2 . 'FACS' . NFAC3 . 'ARTS' = LARTN;
  578.  
  579. FIN B3;
  580. * Remplacer NARTB par NARTA dans les faces concernees
  581. SI ((DIME SAVEARTB) > 0);
  582. ISARTB = INDE SAVEARTB;
  583. REPE B4 (DIME SAVEARTB);
  584. NART4 = ISARTB . &B4;
  585. LFAC4 = TAFC . NART4 . 'FACS';
  586. REPE B41 (DIME LFAC4);
  587. NFAC41 = EXTR LFAC4 &B41;
  588. SI (EXIS (TAB2 . 'FACS') NFAC41);
  589. POSB = POSI NART4 DANS (TAB2 . 'FACS'. NFAC41.'ARTS');
  590. SI (POSB > 0);
  591. *
  592. NARTB = NART4;
  593. REPE B411;
  594. NARTA = SAVEARTB.NARTB;
  595. SI (EXIS SAVEARTB NARTA);
  596. NARTB = NARTA;
  597. ITER B411;
  598. SINO;
  599. QUIT B411;
  600. FINS;
  601. FIN B411;
  602. *
  603. SI(NON(EXIS (TAB2 . 'FACS'. NFAC41.'ARTS') NARTA));
  604. REMP (TAB2 . 'FACS'. NFAC41.'ARTS') POSB NARTA;
  605. SINO;
  606. TAB2 . 'FACS'. NFAC41.'ARTS' = ENLE (TAB2 . 'FACS'. NFAC41.'ARTS')
  607. POSB;
  608. FINS;
  609. *
  610. FINS;
  611. FINS;
  612. FIN B41;
  613. FIN B4;
  614. *
  615. * eliminer les NARTB de tab2;
  616. REPE B40 (DIME SAVEARTB);
  617. TAB2 . 'ARTS' = ENLE (TAB2 . 'ARTS') (ISARTB . &B40);
  618. FIN B40;
  619. FINS;
  620. * Creer les indices VISU des faces
  621. ITFN = INDE (TAB2 . 'FACS');
  622. REPE B5 (DIME ITFN);
  623. NFAC5 = ITFN . &B5;
  624. LART5 = TAB2 . 'FACS' . NFAC5 . 'ARTS';
  625. TAB2 . 'FACS' . NFAC5 . 'VISU' = VIDE MAILLAGE/SEG2;
  626. REPE B51 (DIME LART5);
  627. NART51 = EXTR LART5 &B51;
  628. TAB2 . 'FACS' . NFAC5 . 'VISU' = (TAB2 . 'FACS' . NFAC5 . 'VISU')
  629. ET (TAB2 .'ARTS'.NART51);
  630. FIN B51;
  631. FIN B5;
  632. * Creer la nouvelle table des cellules
  633. ITC = INDE (TAB1 . 'CELL');
  634. SAVEFACB = TABLE;
  635. REPE B6 (DIME ITC);
  636. P6 = ITC . &B6;
  637. LFAC6 = TAB1 .'CELL'.P6 . 'FACS';
  638. LFACN = LECT;
  639. *
  640. REPE B61 (DIME LFAC6);
  641. NFAC61 = EXTR LFAC6 &B61;
  642. SI (EXIS (TAB2 .'FACS') NFAC61);
  643. LFACN = LFACN ET NFAC61;
  644. FINS;
  645. FIN B61;
  646. *
  647. SI (DIME LFACN < 2);
  648. MESS 'NB FACS' (DIME LFACN);
  649. ITER B6;
  650. FINS;
  651. *
  652. SI ((DIME LFACN) EGA 2);
  653. NFACA = EXTR LFACN 1; NFACB = EXTR LFACN 2;
  654. SAVEFACB . NFACB = NFACA;
  655. TAB2 . 'FACS' = ENLE (TAB2 .'FACS') NFACB;
  656. ITER B6;
  657. FINS;
  658. TAB2 . 'CELL' . P6 = TABLE;
  659. TAB2 . 'CELL' . P6 . 'FACS' = LFACN;
  660. TAB2 . 'CELL' .P6 . 'VOIS' = TAB1 . 'CELL' .P6 . 'VOIS';
  661. * Creer l indice VISU de la cellule
  662. CVISU = 'VIDE' 'MAILLAGE'/'SEG2';
  663. REPE B62 ('DIME' LFACN);
  664. NFAC62 = EXTR LFACN &B62;
  665. FAC62 = TAB2.FACS.NFAC62 .VISU;
  666. CVISU = ((CVISU ET FAC62) DIFF (CVISU INTE FAC62 noverif));
  667. FIN B62;
  668. TAB2 . 'CELL' . P6 . 'VISU' = CVISU;
  669. *
  670. FIN B6;
  671. * Remplacer NFACB par NFACA dans les cellules concernees
  672. SI ((DIME SAVEFACB) > 0);
  673. ISFACB = INDE SAVEFACB;
  674. REPE B7 (DIME SAVEFACB);
  675. NFAC7 = ISFACB . &B7;
  676. LCEL7 = TFC . NFAC7;
  677. REPE B71 (NBNO LCEL7);
  678. P71 = LCEL7 POIN &B71;
  679. SI (EXIS (TAB2 . 'CELL') P71);
  680. POSB = POSI NFAC7 DANS (TAB2 . 'CELL'.P71 .'FACS');
  681. SI (POSB > 0);
  682. SI (EXIS SAVEFACB (SAVEFACB.NFAC7));
  683. REMP (TAB2 . 'CELL'. P71 .'FACS')
  684. POSB (SAVEFACB. (SAVEFACB .NFAC7));
  685. SINO;
  686. REMP (TAB2 . 'CELL'. P71 .'FACS') POSB (SAVEFACB.NFAC7);
  687. FINS;
  688. FINS;
  689. FINS;
  690. FIN B71;
  691. FIN B7;
  692. FINS;
  693. *
  694. SINO;
  695. * Creer la nouvelle table des cellules
  696. ITC = INDE (TAB1 . 'CELL');
  697. SAVEARTB = TABLE;
  698. REPE B6 (DIME ITC);
  699. P6 = ITC . &B6;
  700. LART6 = TAB1 .'CELL'.P6 . 'ARTS';
  701. LARTN = LECT;
  702. *
  703. REPE B61 (DIME LART6);
  704. NART61 = EXTR LART6 &B61;
  705. SI (EXIS (TAB2 .'ARTS') NART61);
  706. LARTN = LARTN ET NART61;
  707. FINS;
  708. FIN B61;
  709. *
  710. SI (DIME LARTN < 2);
  711. ITER B6;
  712. FINS;
  713. *
  714. SI ((DIME LARTN) EGA 2);
  715. NARTA = EXTR LARTN 1; NARTB = EXTR LARTN 2;
  716. SAVEARTB . NARTB = NARTA;
  717. * TAB2 . 'ARTS' = ENLE (TAB2 .'ARTS') NARTB;
  718. ITER B6;
  719. FINS;
  720. TAB2 . 'CELL' . P6 = TABLE;
  721. TAB2 . 'CELL' . P6 . 'ARTS' = LARTN;
  722. TAB2 . 'CELL' .P6 . 'VOIS' = TAB1 . 'CELL' .P6 . 'VOIS';
  723. * Creer l indice VISU de la cellule
  724. CVISU = 'VIDE' 'MAILLAGE'/'SEG2';
  725. REPE B62 ('DIME' LARTN);
  726. NART62 = EXTR LARTN &B62;
  727. ART62 = TAB2.ARTS.NART62;
  728. CVISU = ((CVISU ET ART62) DIFF (CVISU INTE ART62 noverif));
  729. FIN B62;
  730. TAB2 . 'CELL' . P6 . 'VISU' = CVISU;
  731. *
  732. FIN B6;
  733. * Remplacer NARTB par NARTA dans les cellules concernees
  734. SI ((DIME SAVEARTB) > 0);
  735. ISARTB = INDE SAVEARTB;
  736. REPE B7 (DIME SAVEARTB);
  737. NART7 = ISARTB . &B7;
  738. LCEL7 = TAC . NART7;
  739. REPE B71 (NBNO LCEL7);
  740. P71 = LCEL7 POIN &B71;
  741. SI (EXIS (TAB2 . 'CELL') P71);
  742. POSB = POSI NART7 DANS (TAB2 . 'CELL'.P71 .'ARTS');
  743. SI (POSB > 0);
  744. SI (EXIS SAVEARTB (SAVEARTB.NART7));
  745. REMP (TAB2 . 'CELL'. P71 .'ARTS')
  746. POSB (SAVEARTB. (SAVEARTB .NART7));
  747. SINO;
  748. REMP (TAB2 . 'CELL'. P71 .'ARTS') POSB (SAVEARTB.NART7);
  749. LISTE (TAB2 . 'CELL'. P71 .'ARTS');
  750. FINS;
  751. FINS;
  752. FINS;
  753. FIN B71;
  754. FIN B7;
  755. FINS;
  756. FINS;
  757. *
  758. *======================================================================*
  759. * MAILLAGE VOLUMIQUE DE LA PARTION DE VORONOI *
  760. *======================================================================*
  761. *
  762. * A t on demande une coloration aleatoire des cellules ?
  763. LOG1 = FAUX ;
  764. SI (EXIS MO1) ;
  765. SI (EGA (TYPE MO1) 'MOT') ;
  766. SI (EGA MO1 'COUL') ;
  767. LOG1 = VRAI ;
  768. LCOUL1 = MOTS 'BLEU' 'ROUG' 'JAUN' 'VERT' 'TURQ' 'AZUR'
  769. 'ORAN' 'VIOL' 'OCEA' 'OLIV' 'GRIS' ;
  770. FINS ;
  771. FINS ;
  772. FINS ;
  773. * Type d'elements a creer et nature des bords des cellules selon la
  774. * dimension
  775. SI (EGA IDIM 2) ;
  776. TYPEL1 = MOT 'TRI3' ;
  777. TYPEL2 = MOT 'SEG2' ;
  778. MBORD = MOT 'ARTS' ;
  779. FINS ;
  780. SI (EGA IDIM 3) ;
  781. TYPEL1 = MOT 'TET4' ;
  782. TYPEL2 = MOT 'TRI3' ;
  783. MBORD = MOT 'FACS' ;
  784. FINS ;
  785. * Initialisation de la table de sortie (sur la meme base que celle issue
  786. * de l'operateur VORO)
  787. TAB20 = TABL ;
  788. TAB20 . 'MAIL' = VIDE 'MAILLAGE'/TYPEL1 ;
  789. TAB20 . 'CELL' = TABL ;
  790. SI (EGA IDIM 3) ;
  791. TAB20 . 'FACS' = TABL ;
  792. FINS ;
  793. TAB20 . 'ARTS' = TABL ;
  794. * Recuperation des tables d'entree
  795. T1C = TAB2 . 'CELL' ;
  796. IT1C = INDE T1C ;
  797. SI (EGA IDIM 3) ;
  798. T1F = TAB2 . 'FACS' ;
  799. FINS ;
  800. T1A = TAB2 . 'ARTS' ;
  801. ITA1 = INDE T1A;
  802. * Boucle 1 : maillage des aretes
  803. REPE B1 (DIME T1A) ;
  804. A1 = T1A . (ITA1 . &B1) ;
  805. P1 = A1 POIN 1 ;
  806. P2 = A1 POIN 2 ;
  807. L12 = NORM (P2 MOIN P1) ;
  808. MA1 = D P1 P2 'DINI' (TDENSS . P1) 'DFIN' (TDENSS . P2) ;
  809. TAB20 . 'ARTS' . (ITA1 . &B1) = MA1 ;
  810. FIN B1 ;
  811. * Boucle 2 : maillage des faces a partir des aretes (dimension 3)
  812. SI (EGA IDIM 3) ;
  813. IT1F = INDE T1F;
  814. REPE B1 (DIME T1F) ;
  815. TAB20 . 'FACS' . (IT1F . &B1) = TABL ;
  816. TAB20 . 'FACS' . (IT1F . &B1). 'MAIL' = 0 ;
  817. LA2 = LECT ;
  818. * construction du contour de la face &B1
  819. CONT1 = VIDE 'MAILLAGE'/'SEG2' ;
  820. LA1 = T1F . (IT1F . &B1) . 'ARTS' ;
  821. REPE B2 (DIME LA1) ;
  822. IA2 = EXTR LA1 &B2 ;
  823. CONT1 = CONT1 ET (TAB20 . 'ARTS' . IA2) ;
  824. LA2 = LA2 ET IA2 ;
  825. FIN B2 ;
  826. * construction de la surface a l'interieur du contour
  827. * ce contour peut etre compose de plusieurs parties, on boucle sur
  828. * les differentes parties connexes
  829. S1 = VIDE 'MAILLAGE'/'TRI3' ;
  830. TC = CCON CONT1 ;
  831. REPE B2 (DIME TC) ;
  832. OPTI 'ERRE' 'IGNO' ;
  833. S2 = SURF (TC . &B2) 'PLANE' 1.0;
  834. OPTI 'ERRE' 'NORM' ;
  835. S1 = S1 ET S2 ;
  836. FIN B2 ;
  837. TAB20 . 'FACS' . (IT1F . &B1) . 'MAIL' = S1 ;
  838. TAB20 . 'FACS' . (IT1F . &B1) . 'ARTS' = LA2 ;
  839. FIN B1 ;
  840. FINS ;
  841. *
  842. * Boucle 3 : maillage des cellules a partir des faces/aretes
  843. REPE B1 (DIME T1C) ;
  844. P1 = IT1C . &B1 ;
  845. TAB20 . 'CELL' . P1 = TABL ;
  846. LAF2 = LECT ;
  847. * assemblage des bords de la cellule
  848. BORD1 = VIDE 'MAILLAGE'/TYPEL2 ;
  849. LAF1 = T1C . P1 . MBORD ;
  850. MV1 = T1C . P1 . 'VOIS' ;
  851. REPE B2 (DIME LAF1) ;
  852. IAF2 = EXTR LAF1 &B2 ;
  853. SI (EGA IDIM 2) ;
  854. BORD1 = BORD1 ET (TAB20 . MBORD . IAF2) ;
  855. FINS ;
  856. SI (EGA IDIM 3) ;
  857. BORD1 = BORD1 ET (TAB20 . MBORD . IAF2 . 'MAIL') ;
  858. FINS ;
  859. LAF2 = LAF2 ET IAF2 ;
  860. FIN B2 ;
  861. * determination d'une couleur pour la cellule aleatoirement et
  862. * differente de celles des cellules voisines
  863. COU1 = MOT 'DEFA' ;
  864. SI LOG1 ;
  865. RAND1 = EXTR (BRUI 'BLAN' 'UNIF' 0.5 0.5 1) 1 ;
  866. RAND1 = RAND1 * (DIME LCOUL1) ;
  867. I1 = (ENTI RAND1) + 1 ;
  868. COU1 = EXTR LCOUL1 I1 ;
  869. L2 = MOTS ;
  870. REPE B2 (NBEL MV1) ;
  871. P2 = MV1 POIN &B2 ;
  872. SI (EXIS (TAB20 . 'CELL') P2) ;
  873. COU2 = TAB20 . 'CELL' . P2 . 'COUL' ;
  874. L2 = L2 ET (MOTS COU2) ;
  875. SI (EXIS L2 COU1) ;
  876. REPE B3 (DIME LCOUL1) ;
  877. I1 = I1 + 1 ;
  878. SI (I1 > (DIME LCOUL1)) ;
  879. I1 = 1 ;
  880. FINS ;
  881. COU1 = EXTR LCOUL1 I1 ;
  882. SI (EXIS L2 COU1) ;
  883. ITER B3 ;
  884. SINO ;
  885. QUIT B3 ;
  886. FINS ;
  887. FIN B3 ;
  888. FINS ;
  889. FINS ;
  890. FIN B2 ;
  891. FINS ;
  892. * construction de la cellule a l'interieur du bord
  893. * ce bord peut etre compose de plusieurs parties, on boucle sur
  894. * les differentes parties connexes
  895. CEL1 = VIDE 'MAILLAGE'/TYPEL1 ;
  896. TC = CCON BORD1 ;
  897. *
  898. REPE B2 (DIME TC) ;
  899. SI (EGA IDIM 2) ;
  900. CEL11 = SURF (TC . &B2) ;
  901. FINS ;
  902. SI (EGA IDIM 3) ;
  903. CEL11 = VOLU (TC . &B2) ;
  904. FINS ;
  905. CEL1 = CEL1 ET CEL11 ;
  906. FIN B2 ;
  907. CEL1 = CEL1 COUL COU1 ;
  908. TAB20 . 'CELL' . P1 . 'MAIL' = CEL1 ;
  909. TAB20 . 'CELL' . P1 . MBORD = LAF2 ;
  910. * maillage des cellules voisines
  911. MV2 = VIDE 'MAILLAGE'/'POI1' ;
  912. REPE B2 (NBEL MV1) ;
  913. PV2 = MV1 POIN &B2 ;
  914. MV2 = MV2 ET PV2 ;
  915. FIN B2 ;
  916. TAB20 . 'CELL' . P1 . 'VOIS' = MV2 ;
  917. * couleur de la cellule
  918. TAB20 . 'CELL' . P1 . 'COUL' = COU1 ;
  919. * maillage global de la partition
  920. TAB20 . 'MAIL' = (TAB20 . 'MAIL') ET CEL1 ;
  921. FIN B1 ;
  922. *
  923. MTRIA1 = TAB20;
  924. *
  925. FINP MTRIA1 ;
  926. *
  927.  
  928.  
  929.  

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