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