Download arete.eso

Back to the list

   1 : C ARETE     SOURCE    PV        09/01/08    21:15:18     6254           
   2 :       SUBROUTINE ARETE
   3 : 
   4 : *
   5 : *       OPERATEUR TRANSFORMANT UN MAILLAGE 3D DE TYPE COMPLEXE
   6 : *       EN UN MAILLAGE 3D COMPOSE UNIQUEMENT DE SEG2 REPRESENTANT
   7 : *       LES ARETES VIVES DU VOLUME.
   8 : *
   9 : *-------------------------------------------------------------------
  10 : *
  11 : *   ARBRE D'APPEL :
  12 : *   --------------
  13 : *         ENVVEL : ELIMINATION PARTIE MASSIVE DU MAILLAGE
  14 : *
  15 : *         ARETE1 : CALCUL DE PREPARATION
  16 : *                  (CALCUL DE NORMALE,TRANSFORMATION EN SEG2)
  17 : *
  18 : *         ARETE3 : ELIMINATION SEGMENTS INUTILES PAR ESTIMATION
  19 : *                  DE LA DIFFERENCE DES NORMALES DE 2 FACETTES ADJACENTE
  20 : *
  21 : *-------------------------------------------------------------------
  22 : *
  23 : *   VARIABLES PRINCIPALES :
  24 : *   ---------------------
  25 : *
  26 : *      TSEG : SEGMENT 2 DIMENSIONS  CONTENANT
  27 : *     | A TRACER (= 0  NON,   =1 OUI)    |
  28 : *     | COULEUR                          |
  29 : *     | N› NOEUD MIN                     |
  30 : *     | N› NOEUD MAX                     |
  31 : *     | ENTREES DANS TSEG                |
  32 : *
  33 : *      TNOR : SEGMENT 2 DIMENSIONS CONTENANT LES NORMALES A COMPARER
  34 : *             POUR CHAQUE FACE ELEMENTAIRE
  35 : *
  36 : *      TINDIC : SEGMENT DONNANT LA POSITION DANS TNOR EN FONCTION
  37 : *               DES 2 NOEUDS
  38 : *
  39 : *      ISEG : TAILLE REELLE DU SEGMENT TSEG
  40 : *      INOR : TAILLE REELLE DU SEGMENT TNOR
  41 : *
  42 : *--------------------------------------------------------------------
  43 : *      AUTEUR : J.BRUN (JUIN 90)
  44 : 
  45 :       IMPLICIT INTEGER(I-N)
  46 :       IMPLICIT REAL*8 (A-H,O-Y)
  47 :       IMPLICIT LOGICAL (Z)
  48 : -INC CCREEL
  49 : -INC SMELEME
  50 : -INC CCOPTIO
  51 : -INC SMCOORD
  52 :       SEGMENT TN
  53 :       REAL*8 TNOR(N1,3)
  54 :       ENDSEGMENT
  55 : *
  56 :       SEGMENT TS
  57 :       INTEGER TSEG(M1,M2)
  58 :       ENDSEGMENT
  59 : *
  60 :       SEGMENT TI
  61 :       INTEGER TINDIC(MI1,MI2,2)
  62 :       ENDSEGMENT
  63 : *
  64 :       SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  65 : *
  66 : C  Operateur disponible en dimension 3
  67 :       IF (IDIM.NE.3) THEN
  68 :         INTERR(1)=IDIM
  68 :         CALL ERREUR(709)
  69 :         RETURN
  70 :       ENDIF
  71 : 
  72 :       CANGLE=COS(XPI/9.D0)
  72 :       CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU)
  73 :       IF (IERR.NE.0) RETURN
  73 :       CALL LIRREE (ANGLE,0,IOK)
  74 : * UN ANGLE ALPHA > 90›  <==> XPI-ALPHA
  75 :       IF (IOK.NE.0) CANGLE=ABS(COS(ANGLE*XPI/180.D0))
  76 : *--------------------------------------------------------------------
  77 : *
  78 : *     ELIMINATION PARTIE MASSIVE
  79 : *
  79 :       CALL ECROBJ('MAILLAGE',MELEME)
  79 :       CALL ENVVOL
  79 :       CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  80 : *--------------------------------------------------------------------
  81 : *
  82 : *     CREATION STRUCTURE ESOPE
  83 : *
  84 :       N1=200
  85 :       SEGINI TN
  86 :       INOR=0
  87 :       M1=200
  88 :       M2=10
  89 :       SEGINI TS
  90 :       ISEG=0
  91 :       MI1=200
  92 :       MI2=3
  93 :       SEGINI TI
  94 :       SEGINI ICPR
  95 :       LCPR=0
  96 : *------------------------------------------------------------------
  97 : *     PREPARATION MAILLAGE
  98 : *
  98 :       CALL ARETE1(MELEME,TS,ISEG,TN,INOR,TI,ICPR,LCPR)
  99 : *------------------------------------------------------------------
 100 : *     ELIMINATION SEG2 INUTILE
 101 : *
 102 : 
 102 :       CALL ARETE3(TS,ISEG,TN,INOR,CANGLE,NBSEG)
 103 : 
 104 :       NBNN=2
 105 :       NBELEM=NBSEG
 106 :       NBSOUS=0
 107 :       NBREF=0
 108 :       SEGINI MELEME
 109 :       ITYPEL=2
 110 :       J=1
 111 :       DO 100 I=1,ISEG
 112 :          IF (TSEG(I,1).EQ.1) THEN
 113 :             ICOLOR(J)=TSEG(I,2)
 114 :             NUM(1,J)=TSEG(I,3)
 115 :             NUM(2,J)=TSEG(I,4)
 116 :             J=J+1
 117 :          ENDIF
 118 :  100  CONTINUE
 119 :       SEGDES MELEME
 120 :       SEGSUP TN,TS,TI,ICPR
 120 :       CALL ECROBJ('MAILLAGE',MELEME)
 121 : 
 122 :       RETURN
 123 : 
 124 :       END
 125 : 
 126 :  
 127 :  
 128 :  
 129 :  

© Cast3M 2003 - All rights reserved.
Disclaimer