Télécharger arete.eso

Retour à la liste

Numérotation des lignes :

  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
  69. CALL ERREUR(709)
  70. RETURN
  71. ENDIF
  72.  
  73. CANGLE=COS(XPI/9.D0)
  74. CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU)
  75. IF (IERR.NE.0) RETURN
  76. CALL LIRREE (ANGLE,0,IOK)
  77. * UN ANGLE ALPHA > 90› <==> XPI-ALPHA
  78. IF (IOK.NE.0) CANGLE=ABS(COS(ANGLE*XPI/180.D0))
  79. *--------------------------------------------------------------------
  80. *
  81. * ELIMINATION PARTIE MASSIVE
  82. *
  83. CALL ECROBJ('MAILLAGE',MELEME)
  84. CALL ENVVOL
  85. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  86. *--------------------------------------------------------------------
  87. *
  88. * CREATION STRUCTURE ESOPE
  89. *
  90. N1=200
  91. SEGINI TN
  92. INOR=0
  93. M1=200
  94. M2=10
  95. SEGINI TS
  96. ISEG=0
  97. MI1=200
  98. MI2=3
  99. SEGINI TI
  100. SEGINI ICPR
  101. LCPR=0
  102. *------------------------------------------------------------------
  103. * PREPARATION MAILLAGE
  104. *
  105. CALL ARETE1(MELEME,TS,ISEG,TN,INOR,TI,ICPR,LCPR)
  106. *------------------------------------------------------------------
  107. * ELIMINATION SEG2 INUTILE
  108. *
  109.  
  110. CALL ARETE3(TS,ISEG,TN,INOR,CANGLE,NBSEG)
  111.  
  112. NBNN=2
  113. NBELEM=NBSEG
  114. NBSOUS=0
  115. NBREF=0
  116. SEGINI MELEME
  117. ITYPEL=2
  118. J=1
  119. DO 100 I=1,ISEG
  120. IF (TSEG(I,1).EQ.1) THEN
  121. ICOLOR(J)=TSEG(I,2)
  122. NUM(1,J)=TSEG(I,3)
  123. NUM(2,J)=TSEG(I,4)
  124. J=J+1
  125. ENDIF
  126. 100 CONTINUE
  127. SEGDES MELEME
  128. SEGSUP TN,TS,TI,ICPR
  129. CALL ECROBJ('MAILLAGE',MELEME)
  130.  
  131. RETURN
  132.  
  133. END
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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