Procédures | Cast3M

* @P_VORO   PROCEDUR  PASCAL    12/10/18    21:15:02     7532           
* PROCEDURE @P_VORO                                                   *
*---------------------------------------------------------------------*
* NOM         : @P_VORO                                               *
*                                                                     *
* DESCRIPTION : Construit la partition de Voronoi d'un ensemble de    *
*               points (maillage de POI1). S'appuie sur une triangu-  *
*               -lation de cet ensemble de points dans une boite de   *
*               dimension finie, ce qui permet de construire les      *
*               polyedres associes a leur enveloppe convexe.          *
*                                                                     *
* SYNTAXE     : TAB1 = @P_VORO MPOI1 (FLOT1) (ILOG1) ;                *
*                                                                     *
*    - MPOI1  = MAILLAGE, nuage de points (POI1) ;                    *
*    - FLOT1  = FLOTTANT, rapport de la taille de la boite de         *
*               triangulation sur la dimension du nuage de points ;   *
*    - ILOG1  = LOGIQUE, mettre a VRAI pour activer TRAC.             *
*    - TAB1   = TABLE, dont chaque indice est un point de MPOI1, dont *
*               le sous-indice 'MAV' contient le Maillage des Aretes  *
*               du polyedre de Voronoi associe a ce point et le sous- *
*               indice 'MPT' celui des Points de la Triangulation     *
*               adjacents a chaque face de ce polyedre.               *
*               De plus, l'indice 'MAV' de la table contient le       *
*               Maillage des Aretes de tous les polyedres et l'indice *
*               'MPT', le maillage MPOI1.                             *
*                                                                     *
* LANGAGE     : GIBIANE-CAST3M                                        *
* AUTEUR      : S. PASCAL (CEA/DEN/DM2S/SEMT/LM2S)                    *
* COURRIEL    : serge.pascal@cea.fr                                   *
*---------------------------------------------------------------------*
* VERSION    : v1, 11/04/2007, version initiale                       *
* HISTORIQUE : v1, 11/04/2007, creation                               *
* HISTORIQUE :                                                        *
* HISTORIQUE :                                                        *
*---------------------------------------------------------------------*
* Priere de PRENDRE LE TEMPS de completer les commentaires            *
* en cas de modification de ce sous-programme afin de faciliter       *
* la maintenance !                                                    *
*---------------------------------------------------------------------*
'DEBP' @P_VORO ;
*                                                                     *
*----------------------- Lecture des arguments -----------------------*
*                                                                     *
'ARGU' MPOI1*'MAILLAGE' ;
*                                                                     *
* Taille de la boite de triangulation :                               *
'ARGU' XBOI1/'FLOTTANT' ;
'SI' ('NON' ('EXIS' XBOI1)) ;
  XBOI1    = 5. ;
'FINS' ;
*                                                                     *
'ARGU' IVISU1/'LOGIQUE' ;
'SI' ('NON' ('EXIS' IVISU1)) ;
  IVISU1   = FAUX ;
'FINS' ;
*                                                                     *
*----------------- Triangulation du nuage de points ------------------*
*                                                                      *
CHX1 CHY1 CHZ1 = MPOI1 'COOR' ;
XMIN1 XMAX1 = ('MINI' CHX1) ('MAXI' CHX1) ;
YMIN1 YMAX1 = ('MINI' CHY1) ('MAXI' CHY1) ;
ZMIN1 ZMAX1 = ('MINI' CHZ1) ('MAXI' CHZ1) ;
PBARY1   = 'BARY' MPOI1 ;
PXXX1    = XBOI1 * ((XMAX1 - XMIN1) 0. 0.) ;
PYYY1    = XBOI1 * (0. (YMAX1 - YMIN1) 0.) ;
PZZZ1    = XBOI1 * (0. 0. (ZMAX1 - ZMIN1)) ;
MPOI2    = MPOI1 'ET' (PBARY1 'PLUS' PXXX1 'PLUS' PYYY1 'PLUS' PZZZ1)
                 'ET' (PBARY1 'PLUS' PXXX1 'PLUS' PYYY1 'MOIN' PZZZ1)
                 'ET' (PBARY1 'PLUS' PXXX1 'MOIN' PYYY1 'PLUS' PZZZ1)
                 'ET' (PBARY1 'PLUS' PXXX1 'MOIN' PYYY1 'MOIN' PZZZ1)
                 'ET' (PBARY1 'MOIN' PXXX1 'PLUS' PYYY1 'PLUS' PZZZ1)
                 'ET' (PBARY1 'MOIN' PXXX1 'PLUS' PYYY1 'MOIN' PZZZ1) 
                 'ET' (PBARY1 'MOIN' PXXX1 'MOIN' PYYY1 'PLUS' PZZZ1)
                 'ET' (PBARY1 'MOIN' PXXX1 'MOIN' PYYY1 'MOIN' PZZZ1) ;
*Trac (MPOI2 'ET' (MPOI1 'COUL' viol)) ;
*                                                                     *
MTRIA1   = 'TRIA' MPOI2 ;
'SI' IVISU1 ;
  'TRAC' (MTRIA1 'ET' (MPOI1 'COUL' 'ROUG')) ;
'FINS' ;
*                                                                     *
*-------------- Construction de la partition de Voronoi --------------*
*                                                                     *
* Taille caracteristique du nuage de points :                         *
X000 Y000 Z000 = 'COOR' MPOI1 ;
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 ;
*                                                                     *
* Boucle sur les points de la partition :                             *
NBI1     = 'NBNO' MPOI1 ;
TPVORO1  = 'TABL' ;
TPVORO1 . 'MPT' = MPOI1 ;
'REPE' BI1 NBI1 ;
  I1       = &BI1 ;
  PTI1     = MPOI1 'POIN' I1 ;
  TPVORO1 . PTI1 = 'TABL' ;
  MTI1     = MTRIA1 'ELEM' 'APPU' 'LARG' PTI1 ;
  MPTJ1    = (MTI1 'CHAN' 'POI1') 'DIFF' ('MANU' 'POI1' PTI1) ;
  TPVORO1 . PTI1 . 'MPT' = MPTJ1 ;
  NBJ1     = 'NBNO' MPTJ1 ;
  'REPE' BJ1 NBJ1 ;
    J1       = &BJ1 ;
    PTJ1     = MPTJ1 'POIN' J1 ;
    'SI' ('EXIS' TPVORO1 PTJ1) ;
      CNTIJ1   = TPVORO1 . PTJ1 . PTI1 . 'MAV' ;
      TPVORO1 . PTI1 . PTJ1 = 'TABL' ;
    'SINO' ;
      TPVORO1 . PTI1 . PTJ1 = 'TABL' ;
      MTIJ1    = MTI1 'ELEM' 'APPU' 'LARG' PTJ1 ;
      MPTK1    = ('CHAN' 'POI1' MTIJ1) 'DIFF' (PTI1 'ET' PTJ1) ;
      NBK1     = 'NBNO' MPTK1 ;
* Initialisation boucle PTK1 :                                        *
      PTK1     = MPTK1 'POIN' 1 ;
      TPVORO1 . PTI1 . PTJ1 . PTK1 = 'TABL' ;
      MTIJK1   = MTIJ1 'ELEM' 'APPU' 'LARG' PTK1 ;
      MPTL1    = ('CHAN' 'POI1' MTIJK1) 'DIFF'
        (PTI1 'ET' PTJ1 'ET' PTK1) ;
      PTL1     = MPTL1 'POIN' 1 ;
      PTIJ1    = PTJ1 'MOIN' PTI1 ;
      PTIK1    = PTK1 'MOIN' PTI1 ;
      PTIL1    = PTL1 'MOIN' PTI1 ;
      XIJKL1   = 'PMIX' PTIJ1 PTIK1 PTIL1 ;
      'SI' (XIJKL1 '<' 0.) ;
        PTL1     = MPTL1 'POIN' 2 ;
      'FINS' ;
      TPVORO1 . PTI1 . PTJ1 . PTK1 . 'PTL' = PTL1 ;
      EIJKL1  = MTIJK1 'ELEM' 'APPU' 'STRI'
        (PTI1 'ET' PTJ1 'ET' PTK1 'ET' PTL1) ;
      PVIJKL1 X1 = @CIRCONS EIJKL1 ;
      TPVORO1 . PTI1 . PTJ1 . PTK1 . PTL1 = PVIJKL1 ;
      'SI' ('NON' ('EXIS' TPVORO1 PVIJKL1)) ;
        TPVORO1 . PVIJKL1 = 'CHAN' 'POI1' EIJKL1 ;
      'FINS' ;
      PTKP1    = PTK1 ;
      PVIJKLP1 = PVIJKL1 ;
* Boucle sur PTK1 :                                                   *
      'REPE' BK1 NBK1 ;
        PTK1     = PTL1 ;
        TPVORO1 . PTI1 . PTJ1 . PTK1 = 'TABL' ;
        MTIJK1   = MTIJ1 'ELEM' 'APPU' 'LARG' PTK1 ;
        MPTL1    = ('CHAN' 'POI1' MTIJK1) 'DIFF'
          (PTI1 'ET' PTJ1 'ET' PTK1) ;
        PTL1     = (MPTL1 'DIFF' ('MANU' 'POI1' PTKP1)) 'POIN' 1 ;
        TPVORO1 . PTI1 . PTJ1 . PTK1 . 'PTL' = PTL1 ;
        EIJKL1  = MTIJK1 'ELEM' 'APPU' 'STRI'
          (PTI1 'ET' PTJ1 'ET' PTK1 'ET' PTL1) ;
        PVIJKL1 X1 = @CIRCONS EIJKL1 ;
        TPVORO1 . PTI1 . PTJ1 . PTK1 . PTL1 = PVIJKL1 ;
        'SI' ('NON' ('EXIS' TPVORO1 PVIJKL1)) ;
          TPVORO1 . PVIJKL1 = 'CHAN' 'POI1' EIJKL1 ;
        'FINS' ;
        AIJK1    = PVIJKLP1 'DROI' 1 PVIJKL1 ;
        TPVORO1 . PTI1 . PTJ1 . PTK1 . 'MAV' = AIJK1 ;
        'SI' (&BK1 'EGA' 1) ;
          CNTIJ1   = AIJK1 ;
        'SINO' ;
          CNTIJ1  = CNTIJ1 'ET' AIJK1 ;
        'FINS' ;
        PTKP1    = PTK1 ;
        PVIJKLP1 = PVIJKL1 ;
      'FIN' BK1 ;
    'FINS' ;
    TPVORO1 . PTI1 . PTJ1 . 'MAV' = CNTIJ1 ;
    'SI' (J1 'EGA' 1) ;
      TPVORO1 . PTI1 . 'MAV' = CNTIJ1 ;
    'SINO' ;
      TPVORO1 . PTI1 . 'MAV' = (TPVORO1 . PTI1 . 'MAV') 'ET' CNTIJ1 ;
    'FINS' ;
  'FIN' BJ1 ;
  'SI' (I1 'EGA' 1) ;
    TPVORO1 . 'MAV' = TPVORO1 . PTI1 . 'MAV' ;
  'SINO' ;
    TPVORO1 . 'MAV' = (TPVORO1 . 'MAV') 'ET' (TPVORO1 . PTI1 . 'MAV') ;
  'FINS' ;
'FIN' BI1 ;
*                                                                     *
*------------------ Elimination des points doubles -------------------*
*                                                                     *
'ELIM' (TPVORO1 . 'MAV') TOL1 ;
*                                                                     *
'SI' IVISU1 ;
  'TRAC' (((TPVORO1 . 'MAV') 'COUL' 'ROUG') 'ET' MPOI1) ;
'FINS' ;
*                                                                     *
*------------------------------ Sortie -------------------------------*
*                                                                     *
'RESP' TPVORO1 ;
*                                                                     *
'FINP' ;
*---------------------------------------------------------------------*
* FIN PROCEDURE @P_VORO                                               *