Télécharger mailvoro.procedur

Retour à la liste

Numérotation des lignes :

  1. * MAILVORO PROCEDUR SP204843 24/03/15 21:15:06 11871
  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 ('&lt;EG' ('DIST' SN1 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 = 'LECT' 1 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' 'DIRE' N1
  329. 'PLAN' (BORDIP POIN 1) (BORDIP POIN 2) (BORDIP 'POIN' 3);
  330. D1 = 'DIST' S10 PRJ1 ;
  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 ('&lt;EG' ('DIST' 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 ('&lt;EG' ('DIST' 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 ('>' ('DIST' SF1 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) (1.3*DIMA) ;
  544. TDENSS.SF2 = MINI (TDENSS.SF2) (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') POSB;
  607. FINS;
  608. *
  609. FINS;
  610. FINS;
  611. FIN B41;
  612. FIN B4;
  613. *
  614. * eliminer les NARTB de tab2;
  615. REPE B40 (DIME SAVEARTB);
  616. TAB2 . 'ARTS' = ENLE (TAB2 . 'ARTS') (ISARTB . &B40);
  617. FIN B40;
  618. FINS;
  619. * Creer les indices VISU des faces
  620. ITFN = INDE (TAB2 . 'FACS');
  621. REPE B5 (DIME ITFN);
  622. NFAC5 = ITFN . &B5;
  623. LART5 = TAB2 . 'FACS' . NFAC5 . 'ARTS';
  624. TAB2 . 'FACS' . NFAC5 . 'VISU' = VIDE MAILLAGE/SEG2;
  625. REPE B51 (DIME LART5);
  626. NART51 = EXTR LART5 &B51;
  627. TAB2 . 'FACS' . NFAC5 . 'VISU' = (TAB2 . 'FACS' . NFAC5 . 'VISU')
  628. ET (TAB2 .'ARTS'.NART51);
  629. FIN B51;
  630. FIN B5;
  631. * Creer la nouvelle table des cellules
  632. ITC = INDE (TAB1 . 'CELL');
  633. SAVEFACB = TABLE;
  634. REPE B6 (DIME ITC);
  635. P6 = ITC . &B6;
  636. LFAC6 = TAB1 .'CELL'.P6 . 'FACS';
  637. LFACN = LECT;
  638. *
  639. REPE B61 (DIME LFAC6);
  640. NFAC61 = EXTR LFAC6 &B61;
  641. SI (EXIS (TAB2 .'FACS') NFAC61);
  642. LFACN = LFACN ET NFAC61;
  643. FINS;
  644. FIN B61;
  645. *
  646. SI (DIME LFACN < 2);
  647. MESS 'NB FACS' (DIME LFACN);
  648. ITER B6;
  649. FINS;
  650. *
  651. SI ((DIME LFACN) EGA 2);
  652. NFACA = EXTR LFACN 1; NFACB = EXTR LFACN 2;
  653. SAVEFACB . NFACB = NFACA;
  654. TAB2 . 'FACS' = ENLE (TAB2 .'FACS') NFACB;
  655. ITER B6;
  656. FINS;
  657. TAB2 . 'CELL' . P6 = TABLE;
  658. TAB2 . 'CELL' . P6 . 'FACS' = LFACN;
  659. TAB2 . 'CELL' .P6 . 'VOIS' = TAB1 . 'CELL' .P6 . 'VOIS';
  660. * Creer l indice VISU de la cellule
  661. CVISU = 'VIDE' 'MAILLAGE'/'SEG2';
  662. REPE B62 ('DIME' LFACN);
  663. NFAC62 = EXTR LFACN &B62;
  664. FAC62 = TAB2.FACS.NFAC62 .VISU;
  665. CVISU = ((CVISU ET FAC62) DIFF (CVISU INTE FAC62 noverif));
  666. FIN B62;
  667. TAB2 . 'CELL' . P6 . 'VISU' = CVISU;
  668. *
  669. FIN B6;
  670. * Remplacer NFACB par NFACA dans les cellules concernees
  671. SI ((DIME SAVEFACB) > 0);
  672. ISFACB = INDE SAVEFACB;
  673. REPE B7 (DIME SAVEFACB);
  674. NFAC7 = ISFACB . &B7;
  675. LCEL7 = TFC . NFAC7;
  676. REPE B71 (NBNO LCEL7);
  677. P71 = LCEL7 POIN &B71;
  678. SI (EXIS (TAB2 . 'CELL') P71);
  679. POSB = POSI NFAC7 DANS (TAB2 . 'CELL'.P71 .'FACS');
  680. SI (POSB > 0);
  681. SI (EXIS SAVEFACB (SAVEFACB.NFAC7));
  682. REMP (TAB2 . 'CELL'. P71 .'FACS')
  683. POSB (SAVEFACB. (SAVEFACB .NFAC7));
  684. SINO;
  685. REMP (TAB2 . 'CELL'. P71 .'FACS') POSB (SAVEFACB.NFAC7);
  686. FINS;
  687. FINS;
  688. FINS;
  689. FIN B71;
  690. FIN B7;
  691. FINS;
  692. *
  693. SINO;
  694. * Creer la nouvelle table des cellules
  695. ITC = INDE (TAB1 . 'CELL');
  696. SAVEARTB = TABLE;
  697. REPE B6 (DIME ITC);
  698. P6 = ITC . &B6;
  699. LART6 = TAB1 .'CELL'.P6 . 'ARTS';
  700. LARTN = LECT;
  701. *
  702. REPE B61 (DIME LART6);
  703. NART61 = EXTR LART6 &B61;
  704. SI (EXIS (TAB2 .'ARTS') NART61);
  705. LARTN = LARTN ET NART61;
  706. FINS;
  707. FIN B61;
  708. *
  709. SI (DIME LARTN < 2);
  710. ITER B6;
  711. FINS;
  712. *
  713. SI ((DIME LARTN) EGA 2);
  714. NARTA = EXTR LARTN 1; NARTB = EXTR LARTN 2;
  715. SAVEARTB . NARTB = NARTA;
  716. * TAB2 . 'ARTS' = ENLE (TAB2 .'ARTS') NARTB;
  717. ITER B6;
  718. FINS;
  719. TAB2 . 'CELL' . P6 = TABLE;
  720. TAB2 . 'CELL' . P6 . 'ARTS' = LARTN;
  721. TAB2 . 'CELL' .P6 . 'VOIS' = TAB1 . 'CELL' .P6 . 'VOIS';
  722. * Creer l indice VISU de la cellule
  723. CVISU = 'VIDE' 'MAILLAGE'/'SEG2';
  724. REPE B62 ('DIME' LARTN);
  725. NART62 = EXTR LARTN &B62;
  726. ART62 = TAB2.ARTS.NART62;
  727. CVISU = ((CVISU ET ART62) DIFF (CVISU INTE ART62 noverif));
  728. FIN B62;
  729. TAB2 . 'CELL' . P6 . 'VISU' = CVISU;
  730. *
  731. FIN B6;
  732. * Remplacer NARTB par NARTA dans les cellules concernees
  733. SI ((DIME SAVEARTB) > 0);
  734. ISARTB = INDE SAVEARTB;
  735. REPE B7 (DIME SAVEARTB);
  736. NART7 = ISARTB . &B7;
  737. LCEL7 = TAC . NART7;
  738. REPE B71 (NBNO LCEL7);
  739. P71 = LCEL7 POIN &B71;
  740. SI (EXIS (TAB2 . 'CELL') P71);
  741. POSB = POSI NART7 DANS (TAB2 . 'CELL'.P71 .'ARTS');
  742. SI (POSB > 0);
  743. SI (EXIS SAVEARTB (SAVEARTB.NART7));
  744. REMP (TAB2 . 'CELL'. P71 .'ARTS')
  745. POSB (SAVEARTB. (SAVEARTB .NART7));
  746. SINO;
  747. REMP (TAB2 . 'CELL'. P71 .'ARTS') POSB (SAVEARTB.NART7);
  748. LISTE (TAB2 . 'CELL'. P71 .'ARTS');
  749. FINS;
  750. FINS;
  751. FINS;
  752. FIN B71;
  753. FIN B7;
  754. FINS;
  755. FINS;
  756. *
  757. *======================================================================*
  758. * MAILLAGE VOLUMIQUE DE LA PARTION DE VORONOI *
  759. *======================================================================*
  760. *
  761. * A t on demande une coloration aleatoire des cellules ?
  762. LOG1 = FAUX ;
  763. SI (EXIS MO1) ;
  764. SI (EGA (TYPE MO1) 'MOT') ;
  765. SI (EGA MO1 'COUL') ;
  766. LOG1 = VRAI ;
  767. LCOUL1 = MOTS 'BLEU' 'ROUG' 'JAUN' 'VERT' 'TURQ' 'AZUR'
  768. 'ORAN' 'VIOL' 'OCEA' 'OLIV' 'GRIS' ;
  769. FINS ;
  770. FINS ;
  771. FINS ;
  772. * Type d'elements a creer et nature des bords des cellules selon la
  773. * dimension
  774. SI (EGA IDIM 2) ;
  775. TYPEL1 = MOT 'TRI3' ;
  776. TYPEL2 = MOT 'SEG2' ;
  777. MBORD = MOT 'ARTS' ;
  778. FINS ;
  779. SI (EGA IDIM 3) ;
  780. TYPEL1 = MOT 'TET4' ;
  781. TYPEL2 = MOT 'TRI3' ;
  782. MBORD = MOT 'FACS' ;
  783. FINS ;
  784. * Initialisation de la table de sortie (sur la meme base que celle issue
  785. * de l'operateur VORO)
  786. TAB20 = TABL ;
  787. TAB20 . 'MAIL' = VIDE 'MAILLAGE'/TYPEL1 ;
  788. TAB20 . 'CELL' = TABL ;
  789. SI (EGA IDIM 3) ;
  790. TAB20 . 'FACS' = TABL ;
  791. FINS ;
  792. TAB20 . 'ARTS' = TABL ;
  793. * Recuperation des tables d'entree
  794. T1C = TAB2 . 'CELL' ;
  795. IT1C = INDE T1C ;
  796. SI (EGA IDIM 3) ;
  797. T1F = TAB2 . 'FACS' ;
  798. FINS ;
  799. T1A = TAB2 . 'ARTS' ;
  800. ITA1 = INDE T1A;
  801. * Boucle 1 : maillage des aretes
  802. REPE B1 (DIME T1A) ;
  803. A1 = T1A . (ITA1 . &B1) ;
  804. P1 = A1 POIN 1 ;
  805. P2 = A1 POIN 2 ;
  806. L12 = DIST P1 P2 ;
  807. MA1 = D P1 P2 'DINI' (TDENSS . P1) 'DFIN' (TDENSS . P2) ;
  808. TAB20 . 'ARTS' . (ITA1 . &B1) = MA1 ;
  809. FIN B1 ;
  810. * Boucle 2 : maillage des faces a partir des aretes (dimension 3)
  811. SI (EGA IDIM 3) ;
  812. IT1F = INDE T1F;
  813. REPE B1 (DIME T1F) ;
  814. TAB20 . 'FACS' . (IT1F . &B1) = TABL ;
  815. TAB20 . 'FACS' . (IT1F . &B1). 'MAIL' = 0 ;
  816. LA2 = LECT ;
  817. * construction du contour de la face &B1
  818. CONT1 = VIDE 'MAILLAGE'/'SEG2' ;
  819. LA1 = T1F . (IT1F . &B1) . 'ARTS' ;
  820. REPE B2 (DIME LA1) ;
  821. IA2 = EXTR LA1 &B2 ;
  822. CONT1 = CONT1 ET (TAB20 . 'ARTS' . IA2) ;
  823. LA2 = LA2 ET IA2 ;
  824. FIN B2 ;
  825. * construction de la surface a l'interieur du contour
  826. * ce contour peut etre compose de plusieurs parties, on boucle sur
  827. * les differentes parties connexes
  828. S1 = VIDE 'MAILLAGE'/'TRI3' ;
  829. TC = CCON CONT1 ;
  830. REPE B2 (DIME TC) ;
  831. OPTI 'ERRE' 'IGNO' ;
  832. S2 = SURF (TC . &B2) 'PLANE' 1.0;
  833. OPTI 'ERRE' 'NORM' ;
  834. S1 = S1 ET S2 ;
  835. FIN B2 ;
  836. TAB20 . 'FACS' . (IT1F . &B1) . 'MAIL' = S1 ;
  837. TAB20 . 'FACS' . (IT1F . &B1) . 'ARTS' = LA2 ;
  838. FIN B1 ;
  839. FINS ;
  840. *
  841. * Boucle 3 : maillage des cellules a partir des faces/aretes
  842. REPE B1 (DIME T1C) ;
  843. P1 = IT1C . &B1 ;
  844. TAB20 . 'CELL' . P1 = TABL ;
  845. LAF2 = LECT ;
  846. * assemblage des bords de la cellule
  847. BORD1 = VIDE 'MAILLAGE'/TYPEL2 ;
  848. LAF1 = T1C . P1 . MBORD ;
  849. MV1 = T1C . P1 . 'VOIS' ;
  850. REPE B2 (DIME LAF1) ;
  851. IAF2 = EXTR LAF1 &B2 ;
  852. SI (EGA IDIM 2) ;
  853. BORD1 = BORD1 ET (TAB20 . MBORD . IAF2) ;
  854. FINS ;
  855. SI (EGA IDIM 3) ;
  856. BORD1 = BORD1 ET (TAB20 . MBORD . IAF2 . 'MAIL') ;
  857. FINS ;
  858. LAF2 = LAF2 ET IAF2 ;
  859. FIN B2 ;
  860. * determination d'une couleur pour la cellule aleatoirement et
  861. * differente de celles des cellules voisines
  862. COU1 = MOT 'DEFA' ;
  863. SI LOG1 ;
  864. RAND1 = EXTR (BRUI 'BLAN' 'UNIF' 0.5 0.5 1) 1 ;
  865. RAND1 = RAND1 * (DIME LCOUL1) ;
  866. I1 = (ENTI RAND1) + 1 ;
  867. COU1 = EXTR LCOUL1 I1 ;
  868. L2 = MOTS ;
  869. REPE B2 (NBEL MV1) ;
  870. P2 = MV1 POIN &B2 ;
  871. SI (EXIS (TAB20 . 'CELL') P2) ;
  872. COU2 = TAB20 . 'CELL' . P2 . 'COUL' ;
  873. L2 = L2 ET (MOTS COU2) ;
  874. SI (EXIS L2 COU1) ;
  875. REPE B3 (DIME LCOUL1) ;
  876. I1 = I1 + 1 ;
  877. SI (I1 > (DIME LCOUL1)) ;
  878. I1 = 1 ;
  879. FINS ;
  880. COU1 = EXTR LCOUL1 I1 ;
  881. SI (EXIS L2 COU1) ;
  882. ITER B3 ;
  883. SINO ;
  884. QUIT B3 ;
  885. FINS ;
  886. FIN B3 ;
  887. FINS ;
  888. FINS ;
  889. FIN B2 ;
  890. FINS ;
  891. * construction de la cellule a l'interieur du bord
  892. * ce bord peut etre compose de plusieurs parties, on boucle sur
  893. * les differentes parties connexes
  894. CEL1 = VIDE 'MAILLAGE'/TYPEL1 ;
  895. TC = CCON BORD1 ;
  896. *
  897. REPE B2 (DIME TC) ;
  898. SI (EGA IDIM 2) ;
  899. CEL11 = SURF (TC . &B2) ;
  900. FINS ;
  901. SI (EGA IDIM 3) ;
  902. CEL11 = VOLU (TC . &B2) ;
  903. FINS ;
  904. CEL1 = CEL1 ET CEL11 ;
  905. FIN B2 ;
  906. CEL1 = CEL1 COUL COU1 ;
  907. TAB20 . 'CELL' . P1 . 'MAIL' = CEL1 ;
  908. TAB20 . 'CELL' . P1 . MBORD = LAF2 ;
  909. * maillage des cellules voisines
  910. MV2 = VIDE 'MAILLAGE'/'POI1' ;
  911. REPE B2 (NBEL MV1) ;
  912. PV2 = MV1 POIN &B2 ;
  913. MV2 = MV2 ET PV2 ;
  914. FIN B2 ;
  915. TAB20 . 'CELL' . P1 . 'VOIS' = MV2 ;
  916. * couleur de la cellule
  917. TAB20 . 'CELL' . P1 . 'COUL' = COU1 ;
  918. * maillage global de la partition
  919. TAB20 . 'MAIL' = (TAB20 . 'MAIL') ET CEL1 ;
  920. FIN B1 ;
  921. *
  922. MTRIA1 = TAB20;
  923. *
  924. FINP MTRIA1 ;
  925.  
  926.  
  927.  

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