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