1 : * @M_VORO PROCEDUR PASCAL 12/10/18 21:15:02 7532 2 : *---------------------------------------------------------------------* 3 : * NOM : @M_VORO * 4 : * * 5 : * DESCRIPTION : Procedure de maillage d'un agregat cubique de poly- * 6 : * -edres de Voronoi. * 7 : * * 8 : * SYNTAXE : TAB2 = @M_VORO TAB1 DENS1 (FLOT1) (ITRA1) ; * 9 : * * 10 : * - TAB1 = TABLE, resultat de la procedure @P_BOIT ; * 11 : * - DENS1 = FLOTTANT, densite du maillage ; * 12 : * - FLOT1 = FLOTTANT, critere pour l'elimination de facettes trop * 13 : * petites des polyedres (0,3xDENS1 par defaut) ; * 14 : * - ITRA1 = LOGIQUE, active des traces (pour DeBogage) ; * 15 : * - TAB2 = TABLE, dont l'indice 'MAIL' contient le maillage de * 16 : * l'agregat, l'indice 'ARET' celui des aretes de cha- * 17 : * -que polyedres (pour traces). * 18 : * De plus, chaque point de la partition de Voronoi sert * 19 : * d'indice pour le maillage du polyedre qui lui est as- * 20 : * -socie (TAB2 . PT1 . 'MAIL', TAB2 . PT1 . 'ARET'). * 21 : * * 22 : * LANGAGE : GIBIANE-CAST3M * 23 : * AUTEUR : S. PASCAL (CEA/DEN/DM2S/SEMT/LM2S) * 24 : * COURRIEL : serge.pascal@cea.fr * 25 : *---------------------------------------------------------------------* 26 : * VERSION : v1, 21/04/2008, version initiale * 27 : * HISTORIQUE : v1, 11/04/2008, creation * 28 : * HISTORIQUE : v1, 15/04/2008, debogage * 29 : * HISTORIQUE : v1, 21/04/2008, debogage * 30 : *---------------------------------------------------------------------* 31 : * Priere de PRENDRE LE TEMPS de completer les commentaires * 32 : * en cas de modification de ce sous-programme afin de faciliter * 33 : * la maintenance ! * 34 : *---------------------------------------------------------------------* 35 : 'DEBP' @M_VORO ; 36 : * * 37 : *----------------------- Lecture des arguments -----------------------* 38 : * * 39 : 'ARGU' THO7U*'TABLE' ; 40 : * * 41 : 'ARGU' DMAIL1*'FLOTTANT' ; 42 : * * 43 : 'ARGU' XELIM1/'FLOTTANT' ; 44 : 'SI' ('NON' ('EXIS' XELIM1)) ; 45 : XELIM1 = 0.3 ; 46 : 'FINS' ; 47 : * * 48 : 'ARGU' ITRAC1/'LOGIQUE' ; 49 : 'SI' ('NON' ('EXIS' ITRAC1)) ; 50 : ITRAC1 = VRAI ; 51 : 'FINS' ; 52 : * * 53 : * Taille caracteristique du nuage de points : * 54 : MVORO1 = THO7U . 'MAV' ; 55 : X000 Y000 Z000 = 'COOR' MVORO1 ; 56 : L000 = ('MAXI' ('PROG' ('MAXI' X000) ('MAXI' Y000) ('MAXI' Z000))) 57 : - ('MINI' ('PROG' ('MINI' X000) ('MINI' Y000) ('MAXI' Z000))) ; 58 : 'OUBL' X000 ; 'OUBL' Y000 ; 'OUBL' Z000 ; 59 : TOL1 = 1.E-9 * L000 ; 60 : * * 61 : *--------------- << Simplification >> de la partition ----------------* 62 : * * 63 : 'ELIM' MVORO1 (XELIM1 * DMAIL1) ; 64 : * * 65 : * Je recolle les points des surfaces sur les plans X=0, Y=0... 66 : PM1 = 0. 0. 0. ; 67 : PM2 = 1. 0. 0. ; 68 : PM3 = 1. 1. 0. ; 69 : PM4 = 0. 1. 0. ; 70 : PM5 = 0. 0. 1. ; 71 : PM6 = 1. 0. 1. ; 72 : PM7 = 1. 1. 1. ; 73 : PM8 = 0. 1. 1. ; 74 : 'DEPL' (THO7U . 'FACE1') 'PROJ' 'CYLI' (-1. * PM5) 'PLAN' PM1 PM2 PM3 ; 75 : 'DEPL' (THO7U . 'FACE2') 'PROJ' 'CYLI' (-1. * PM4) 'PLAN' PM1 PM2 PM5 ; 76 : 'DEPL' (THO7U . 'FACE3') 'PROJ' 'CYLI' (-1. * PM2) 'PLAN' PM1 PM4 PM5 ; 77 : 'DEPL' (THO7U . 'FACE4') 'PROJ' 'CYLI' PM2 'PLAN' PM2 PM3 PM6 ; 78 : 'DEPL' (THO7U . 'FACE5') 'PROJ' 'CYLI' PM4 'PLAN' PM3 PM4 PM7 ; 79 : 'DEPL' (THO7U . 'FACE6') 'PROJ' 'CYLI' PM5 'PLAN' PM5 PM6 PM7 ; 80 : * * 81 : *------------------------------ Maillage -----------------------------* 82 : * * 83 : * Boucle sur Points de la Partition : * 84 : * * 85 : * List de couleurs pour traces : * 86 : LCOUL1 = 'MOTS' 'BLEU' 'ROUG' 'ROSE' 'JAUN' 'VERT' 'TURQ' 'BLAN' 87 : 'AZUR' 'ORAN' 'VIOL' 'OCEA' 'CYAN' 'OLIV' 'GRIS' ; 88 : NBCOUL1 = 'DIME' LCOUL1 ; 89 : * * 90 : MPOI1 = THO7U . 'MPT' ; 91 : NBI1 = 'NBNO' MPOI1 ; 92 : TMVORO1 = 'TABL' ; 93 : IPREMI1 = VRAI ; 94 : IPREMS1 = VRAI ; 95 : 'REPE' BI1 NBI1 ; 96 : I1 = &BI1 ; 97 : COULI1 = 'EXTR' LCOUL1 (I1 - (I1 - 1 / NBCOUL1 * NBCOUL1)) ; 98 : PTI1 = MPOI1 'POIN' I1 ; 99 : MPTJ1 = THO7U . PTI1 . 'MPT' ; 100 : 'SI' (('NBNO' (THO7U . PTI1 . 'MAV')) '>' 3) ; 101 : 'SAUT' 1 'LIGN' ; 102 : 'MESS' ('CHAI' '---------------------------- Polyedre ' 103 : I1 ' / ' NBI1 ' ----------------------------') ; 104 : TMVORO1 . PTI1 = 'TABL' ; 105 : NBJ1 = 'NBNO' MPTJ1 ; 106 : IPREMJ1 = VRAI ; 107 : 'REPE' BJ1 NBJ1 ; 108 : J1 = &BJ1 ; 109 : PTJ1 = MPTJ1 'POIN' J1 ; 110 : MVIJ1 = (THO7U . PTI1 . PTJ1 . 'MAV') ; 111 : NBK1 = 'NBEL' MVIJ1 ; 112 : 'SI' (('NBNO' MVIJ1) '>' 2) ; 113 : 'SI' ('EXIS' TMVORO1 PTJ1) ; 114 : SIJ1 = TMVORO1 . PTJ1 . PTI1 . 'MAIL' ; 115 : 'SINO' ; 116 : IPREMK1 = VRAI ; 117 : 'REPE' BK1 NBK1 ; 118 : K1 = &BK1 ; 119 : ELK1 = MVIJ1 'ELEM' K1 ; 120 : PVK1 = ELK1 'POIN' 1 ; 121 : PVK2 = ELK1 'POIN' 2 ; 122 : 'SI' (PVK1 'NEG' PVK2 TOL1) ; 123 : DK12 = 'MINI' 124 : ('PROG' ('NORM' (PVK1 'MOIN' PVK2)) DMAIL1) ; 125 : AIJK1 = 'DROI' PVK1 PVK2 'DINI' DK12 'DFIN' DK12 ; 126 : 'SI' IPREMK1 ; 127 : CNTIJ1 = AIJK1 ; 128 : IPREMK1 = FAUX ; 129 : 'SINO' ; 130 : CNTIJ1 = CNTIJ1 'ET' AIJK1 ; 131 : 'FINS' ; 132 : 'FINS' ; 133 : 'FIN' BK1 ; 134 : SIJ1 = 'SURF' CNTIJ1 'PLAN' 1.1 ; 135 : SIJ1 = SIJ1 'COUL' COULI1 ; 136 : 'SI' IPREMS1 ; 137 : IPREMS1 = FAUX ; 138 : TMVORO1 . 'SURF' = SIJ1 ; 139 : 'SINO' ; 140 : TMVORO1 . 'SURF' = (TMVORO1 . 'SURF') 'ET' SIJ1 ; 141 : 'FINS' ; 142 : 'FINS' ; 143 : TMVORO1 . PTI1 . PTJ1 = 'TABL' ; 144 : TMVORO1 . PTI1 . PTJ1 . 'MAIL' = SIJ1 ; 145 : 'SI' IPREMJ1 ; 146 : ENVI1 = SIJ1 ; 147 : TMVORO1 . PTI1 . 'MPT' = PTJ1 ; 148 : IPREMJ1 = FAUX ; 149 : 'SINO' ; 150 : ENVI1 = ENVI1 'ET' SIJ1 ; 151 : TMVORO1 . PTI1 . 'MPT' = (TMVORO1 . PTI1 . 'MPT') 'ET' PTJ1 ; 152 : 'FINS' ; 153 : 'FINS' ; 154 : 'FIN' BJ1 ; 155 : 'ELIM' ENVI1 TOL1 ; 156 : VI1 = 'VOLU' ENVI1 ; 157 : VI1 = VI1 'COUL' COULI1 ; 158 : AVI1 = 'ARET' VI1 ; 159 : TMVORO1 . PTI1 . 'MAIL' = VI1 ; 160 : TMVORO1 . PTI1 . 'ARET' = AVI1 ; 161 : 'SI' IPREMI1 ; 162 : TMVORO1 . 'MPT' = PTI1 ; 163 : TMVORO1 . 'MAIL' = VI1 ; 164 : TMVORO1 . 'ARET' = AVI1 ; 165 : IPREMI1 = FAUX ; 166 : 'SINO' ; 167 : TMVORO1 . 'MPT' = (TMVORO1 . 'MPT') 'ET' PTI1 ; 168 : TMVORO1 . 'MAIL' = (TMVORO1 . 'MAIL') 'ET' VI1 ; 169 : TMVORO1 . 'ARET' = (TMVORO1 . 'ARET') 'ET' AVI1 ; 170 : 'FINS' ; 171 : 'FINS' ; 172 : 'FIN' BI1 ; 173 : * * 174 : * Nettoyage : * 175 : 'ELIM' (TMVORO1 . 'MAIL') TOL1 ; 176 : * * 177 : *--------------------- Verification du maillage ----------------------* 178 : * * 179 : * Verif. maillage : Si le mailleur libre volumique n'a pas reussi a * 180 : * tout mailler correctement, l'operateur ENVEloppe doit renvoyer des * 181 : * elements a l'interieur du cube : * 182 : MAIL1 = TMVORO1 . 'MAIL' ; 183 : ENVM1 = 'ENVE' MAIL1 ; 184 : X1 Y1 Z1 = MAIL1 'COOR' ; 185 : MPX0X1 = (X1 'POIN' 'EGAL' 0.) 'ET' (X1 'POIN' 'EGAL' 1.) ; 186 : MPY0Y1 = (Y1 'POIN' 'EGAL' 0.) 'ET' (Y1 'POIN' 'EGAL' 1.) ; 187 : MPZ0Z1 = (Z1 'POIN' 'EGAL' 0.) 'ET' (Z1 'POIN' 'EGAL' 1.) ; 188 : ENVC1 = ENVM1 'ELEM' 'APPU' (MPX0X1 'ET' MPY0Y1 'ET' MPZ0Z1) ; 189 : MTEST1 = ENVM1 'DIFF' ENVC1 ; 190 : IOKAY1 = ('NBNO' MTEST1) 'EGA' 0 ; 191 : * * 192 : *----------------- Trace + Quelques infos en sortie ------------------* 193 : * * 194 : VECH1 = 'VALE' 'ECHO' ; 195 : 'OPTI' 'ECHO' 0 ; 196 : 'SAUT' 1 'LIGN' ; 197 : 'SI' IOKAY1 ; 198 : 'SAUT' 1 'LIGN' ; 199 : 'MESS' 200 : '--------------------- @M_VORO : Maillage Reussi ---------------------' 201 : ; 202 : * * 203 : NBNOEU1 = 'NBNO' (TMVORO1 . 'MAIL') ; 204 : NBELEM1 = 'NBEL' (TMVORO1 . 'MAIL') ; 205 : TIT1 = 'CHAI' 'Nb. Grains : ' NBG1 ' / Noeuds : ' NBNOEU1 206 : ' / Elements : ' NBELEM1 ; 207 : 'SI' ITRAC1 ; 208 : 'TRAC' 'FACE' (TMVORO1 . 'MAIL') 'TITR' TIT1 ; 209 : 'TRAC' 'FACE' (TMVORO1 . 'MAIL') (TMVORO1 . 'ARET') 'TITR' TIT1 ; 210 : X1 Y1 Z1 = TMVORO1 . 'SURF' 'COOR' ; 211 : Y1 = (((Y1 * 300.) + 30.) 'SIN') * 0.05 ; 212 : CH1 = (0.7 * X1) + Y1 + (0.3 * Z1) ; 213 : MPOI1 = CH1 'POIN' 'INFE' 0.5 ; 214 : 'TRAC' 'FACE' ( TMVORO1 . 'SURF' 'ELEM' 'APPU' MPOI1) 'TITR' TIT1 ; 215 : 'SINO' ; 216 : 'SAUT' 1 'LIGN' ; 217 : 'MESS' 218 : ' ***** Caracteristiques de l"agregat cubique de polyedres genere :' ; 219 : 'MESS' TIT1 ; 220 : 'SAUT' 1 'LIGN' ; 221 : 'FINS' ; 222 : 'SINO' ; 223 : 'MESS' 224 : '################### ATTENTION : Maillage Echoue ! ###################' 225 : ; 226 : 'FINS' ; 227 : 'OPTI' 'ECHO' VECH1 ; 228 : * * 229 : 'RESP' TMVORO1 ; 230 : * * 231 : 'FINP' ; 232 : *---------------------------------------------------------------------* 233 : * FIN PROCEDURE @M_VORO * 234 :
© Cast3M 2003 - All rights reserved.
Disclaimer