Télécharger @m_voro.procedur

Retour à la liste

Numérotation des lignes :

  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.  
  235.  

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