Procédures | Cast3M

* @M_VORO   PROCEDUR  PASCAL    12/10/18    21:15:02     7532           
*---------------------------------------------------------------------*
* NOM         : @M_VORO                                               *
*                                                                     *
* DESCRIPTION : Procedure de maillage d'un agregat cubique de poly-   *
*               -edres de Voronoi.                                    *
*                                                                     *
* SYNTAXE     : TAB2 = @M_VORO TAB1 DENS1 (FLOT1) (ITRA1) ;           *
*                                                                     *
*    - TAB1   = TABLE, resultat de la procedure @P_BOIT ;             *
*    - DENS1  = FLOTTANT, densite du maillage ;                       *
*    - FLOT1  = FLOTTANT, critere pour l'elimination de facettes trop *
*               petites des polyedres (0,3xDENS1 par defaut) ;        *
*    - ITRA1  = LOGIQUE, active des traces (pour DeBogage) ;          *
*    - TAB2   = TABLE, dont l'indice 'MAIL' contient le maillage de   *
*               l'agregat, l'indice 'ARET' celui des aretes de cha-   *
*               -que polyedres (pour traces).                         *
*               De plus, chaque point de la partition de Voronoi sert *
*               d'indice pour le maillage du polyedre qui lui est as- *
*               -socie (TAB2 . PT1 . 'MAIL', TAB2 . PT1 . 'ARET').    *
*                                                                     *
* LANGAGE     : GIBIANE-CAST3M                                        *
* AUTEUR      : S. PASCAL (CEA/DEN/DM2S/SEMT/LM2S)                    *
* COURRIEL    : serge.pascal@cea.fr                                   *
*---------------------------------------------------------------------*
* VERSION    : v1, 21/04/2008, version initiale                       *
* HISTORIQUE : v1, 11/04/2008, creation                               *
* HISTORIQUE : v1, 15/04/2008, debogage                               *
* HISTORIQUE : v1, 21/04/2008, debogage                               *
*---------------------------------------------------------------------*
* Priere de PRENDRE LE TEMPS de completer les commentaires            *
* en cas de modification de ce sous-programme afin de faciliter       *
* la maintenance !                                                    *
*---------------------------------------------------------------------*
'DEBP' @M_VORO ;
*                                                                     *
*----------------------- Lecture des arguments -----------------------*
*                                                                     *
'ARGU' THO7U*'TABLE' ;
*                                                                     *
'ARGU' DMAIL1*'FLOTTANT' ;
*                                                                     *
'ARGU' XELIM1/'FLOTTANT' ;
'SI' ('NON' ('EXIS' XELIM1)) ;
  XELIM1   = 0.3 ;
'FINS' ;
*                                                                     *
'ARGU' ITRAC1/'LOGIQUE' ;
'SI' ('NON' ('EXIS' ITRAC1)) ;
  ITRAC1   = VRAI ;
'FINS' ;
*                                                                     *
* Taille caracteristique du nuage de points :                         *
MVORO1   = THO7U . 'MAV' ;
X000 Y000 Z000 = 'COOR' MVORO1 ;
L000     = ('MAXI' ('PROG' ('MAXI' X000) ('MAXI' Y000) ('MAXI' Z000)))
  - ('MINI' ('PROG' ('MINI' X000) ('MINI' Y000) ('MAXI' Z000))) ;
'OUBL' X000 ; 'OUBL' Y000 ; 'OUBL' Z000 ;
TOL1     = 1.E-9 * L000 ;
*                                                                     *
*--------------- << Simplification >> de la partition ----------------*
*                                                                     *
'ELIM' MVORO1 (XELIM1 * DMAIL1) ;
*                                                                     *
* Je recolle les points des surfaces sur les plans X=0, Y=0...
PM1      = 0. 0. 0. ;
PM2      = 1. 0. 0. ;
PM3      = 1. 1. 0. ;
PM4      = 0. 1. 0. ;
PM5      = 0. 0. 1. ;
PM6      = 1. 0. 1. ;
PM7      = 1. 1. 1. ;
PM8      = 0. 1. 1. ;
'DEPL' (THO7U . 'FACE1') 'PROJ' 'CYLI' (-1. * PM5) 'PLAN' PM1 PM2 PM3 ;
'DEPL' (THO7U . 'FACE2') 'PROJ' 'CYLI' (-1. * PM4) 'PLAN' PM1 PM2 PM5 ;
'DEPL' (THO7U . 'FACE3') 'PROJ' 'CYLI' (-1. * PM2) 'PLAN' PM1 PM4 PM5 ;
'DEPL' (THO7U . 'FACE4') 'PROJ' 'CYLI' PM2 'PLAN' PM2 PM3 PM6 ;
'DEPL' (THO7U . 'FACE5') 'PROJ' 'CYLI' PM4 'PLAN' PM3 PM4 PM7 ;
'DEPL' (THO7U . 'FACE6') 'PROJ' 'CYLI' PM5 'PLAN' PM5 PM6 PM7 ;
*                                                                     *
*------------------------------ Maillage -----------------------------*
*                                                                     *
* Boucle sur Points de la Partition :                                 *
*                                                                     *
* List de couleurs pour traces :                                      *
LCOUL1   = 'MOTS' 'BLEU' 'ROUG' 'ROSE' 'JAUN' 'VERT' 'TURQ' 'BLAN'
  'AZUR' 'ORAN' 'VIOL' 'OCEA' 'CYAN' 'OLIV' 'GRIS' ;
NBCOUL1  = 'DIME' LCOUL1 ;
*                                                                     *
MPOI1    = THO7U . 'MPT' ;
NBI1     = 'NBNO' MPOI1 ;
TMVORO1  = 'TABL' ;
IPREMI1  = VRAI ;
IPREMS1  = VRAI ;
'REPE' BI1 NBI1 ;
  I1       = &BI1 ;
  COULI1   = 'EXTR' LCOUL1 (I1 - (I1 - 1 / NBCOUL1 * NBCOUL1)) ;
  PTI1     = MPOI1 'POIN' I1 ;
  MPTJ1    = THO7U . PTI1 . 'MPT' ;
  'SI' (('NBNO' (THO7U . PTI1 . 'MAV')) '>' 3) ;
    'SAUT' 1 'LIGN' ;
    'MESS' ('CHAI' '---------------------------- Polyedre '
      I1 ' / ' NBI1 ' ----------------------------') ;
    TMVORO1 . PTI1 = 'TABL' ;
    NBJ1     = 'NBNO' MPTJ1 ;
    IPREMJ1  = VRAI ;
    'REPE' BJ1 NBJ1 ;
      J1       = &BJ1 ;
      PTJ1     = MPTJ1 'POIN' J1 ;
      MVIJ1    = (THO7U . PTI1 . PTJ1 . 'MAV') ;
      NBK1     = 'NBEL' MVIJ1 ;
      'SI' (('NBNO' MVIJ1) '>' 2) ;
        'SI' ('EXIS' TMVORO1 PTJ1) ;
          SIJ1     = TMVORO1 . PTJ1 . PTI1 . 'MAIL' ;
        'SINO' ;
          IPREMK1  = VRAI ;
          'REPE' BK1 NBK1 ;
            K1       = &BK1 ;
            ELK1     = MVIJ1 'ELEM' K1 ;
            PVK1     = ELK1 'POIN' 1 ;
            PVK2     = ELK1 'POIN' 2 ;
            'SI' (PVK1 'NEG' PVK2 TOL1) ;
              DK12     = 'MINI'
                ('PROG' ('NORM' (PVK1 'MOIN' PVK2)) DMAIL1) ;
              AIJK1    = 'DROI' PVK1 PVK2 'DINI' DK12 'DFIN' DK12 ;
              'SI' IPREMK1 ;
                CNTIJ1   = AIJK1 ;
                IPREMK1  = FAUX ;
              'SINO' ;
                CNTIJ1   = CNTIJ1 'ET' AIJK1 ;
              'FINS' ;
            'FINS' ;
          'FIN' BK1 ;
          SIJ1     = 'SURF' CNTIJ1 'PLAN' 1.1 ;
          SIJ1     = SIJ1 'COUL' COULI1 ;
          'SI' IPREMS1 ;
            IPREMS1  = FAUX ;
            TMVORO1 . 'SURF' = SIJ1 ;
          'SINO' ;
            TMVORO1 . 'SURF' = (TMVORO1 . 'SURF') 'ET' SIJ1 ;
          'FINS' ;
        'FINS' ;
        TMVORO1 . PTI1 . PTJ1 = 'TABL' ;
        TMVORO1 . PTI1 . PTJ1 . 'MAIL' = SIJ1 ;
        'SI' IPREMJ1 ;
          ENVI1    = SIJ1 ;
          TMVORO1 . PTI1 . 'MPT'  = PTJ1 ;
          IPREMJ1  = FAUX ;
        'SINO' ;
          ENVI1    = ENVI1 'ET' SIJ1 ;
          TMVORO1 . PTI1 . 'MPT'  = (TMVORO1 . PTI1 . 'MPT') 'ET' PTJ1 ;
        'FINS' ;
      'FINS' ;
    'FIN' BJ1 ;
    'ELIM' ENVI1 TOL1 ;
    VI1      = 'VOLU' ENVI1 ;
    VI1      = VI1 'COUL' COULI1 ;
    AVI1     = 'ARET' VI1 ;
    TMVORO1 . PTI1 . 'MAIL' = VI1 ;
    TMVORO1 . PTI1 . 'ARET' = AVI1 ;
    'SI' IPREMI1 ;
      TMVORO1 . 'MPT'  = PTI1 ;
      TMVORO1 . 'MAIL' = VI1 ;
      TMVORO1 . 'ARET' = AVI1 ;
      IPREMI1  = FAUX ;
    'SINO' ;
      TMVORO1 . 'MPT'  = (TMVORO1 . 'MPT') 'ET' PTI1 ;
      TMVORO1 . 'MAIL' = (TMVORO1 . 'MAIL') 'ET' VI1 ;
      TMVORO1 . 'ARET' = (TMVORO1 . 'ARET') 'ET' AVI1 ;
    'FINS' ;
  'FINS' ;
'FIN' BI1 ;
*                                                                     *
* Nettoyage :                                                         *
'ELIM' (TMVORO1 . 'MAIL') TOL1 ;
*                                                                     *
*--------------------- Verification du maillage ----------------------*
*                                                                     *
* Verif. maillage : Si le mailleur libre volumique n'a pas reussi a   *
* tout mailler correctement, l'operateur ENVEloppe doit renvoyer des  *
* elements a l'interieur du cube :                                    *
MAIL1    = TMVORO1 . 'MAIL' ;
ENVM1    = 'ENVE' MAIL1 ;
X1 Y1 Z1 = MAIL1 'COOR' ;
MPX0X1   = (X1 'POIN' 'EGAL' 0.) 'ET' (X1 'POIN' 'EGAL' 1.) ;
MPY0Y1   = (Y1 'POIN' 'EGAL' 0.) 'ET' (Y1 'POIN' 'EGAL' 1.) ;
MPZ0Z1   = (Z1 'POIN' 'EGAL' 0.) 'ET' (Z1 'POIN' 'EGAL' 1.) ;
ENVC1    = ENVM1 'ELEM' 'APPU' (MPX0X1 'ET' MPY0Y1 'ET' MPZ0Z1) ;
MTEST1   = ENVM1 'DIFF' ENVC1 ;
IOKAY1   = ('NBNO' MTEST1) 'EGA' 0 ;
*                                                                     *
*----------------- Trace + Quelques infos en sortie ------------------*
*                                                                     *
VECH1    = 'VALE' 'ECHO' ;
'OPTI' 'ECHO' 0 ;
'SAUT' 1 'LIGN' ;
'SI' IOKAY1 ;
  'SAUT' 1 'LIGN' ;
  'MESS'
'--------------------- @M_VORO : Maillage Reussi ---------------------'
    ;
*                                                                     *
  NBNOEU1  = 'NBNO' (TMVORO1 . 'MAIL') ;
  NBELEM1  = 'NBEL' (TMVORO1 . 'MAIL') ;
  TIT1     = 'CHAI' 'Nb. Grains : ' NBG1 ' / Noeuds : ' NBNOEU1
  ' / Elements : ' NBELEM1 ;
  'SI' ITRAC1 ;
    'TRAC' 'FACE' (TMVORO1 . 'MAIL') 'TITR' TIT1 ;
    'TRAC' 'FACE' (TMVORO1 . 'MAIL') (TMVORO1 . 'ARET') 'TITR' TIT1 ;
    X1 Y1 Z1 = TMVORO1 . 'SURF' 'COOR' ;
    Y1       = (((Y1 * 300.) + 30.) 'SIN') * 0.05 ;
    CH1      = (0.7 * X1) + Y1  + (0.3 * Z1) ;
    MPOI1    = CH1 'POIN' 'INFE' 0.5 ;
    'TRAC' 'FACE' ( TMVORO1 . 'SURF' 'ELEM' 'APPU' MPOI1) 'TITR' TIT1 ;
  'SINO' ;
    'SAUT' 1 'LIGN' ;
    'MESS'
  ' ***** Caracteristiques de l"agregat cubique de polyedres genere :' ;
    'MESS' TIT1 ;
    'SAUT' 1 'LIGN' ;
  'FINS' ;
'SINO' ;
  'MESS'
'################### ATTENTION : Maillage Echoue ! ###################'
  ;
'FINS' ;
'OPTI' 'ECHO' VECH1 ;
*                                                                     *
'RESP' TMVORO1 ;
*                                                                     *
'FINP' ;
*---------------------------------------------------------------------*
* FIN PROCEDURE @M_VORO                                               *