Télécharger la plaquette Cast3M


fr en

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