Télécharger arete.eso

Retour à la liste

Numérotation des lignes :

arete
  1. C ARETE SOURCE PV 20/04/17 21:15:00 10585
  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.  
  51. -INC PPARAM
  52. -INC CCOPTIO
  53. -INC SMCOORD
  54. SEGMENT TN
  55. REAL*8 TNOR(N1,3)
  56. ENDSEGMENT
  57. *
  58. SEGMENT TS
  59. INTEGER TSEG(M1,M2)
  60. ENDSEGMENT
  61. *
  62. SEGMENT TI
  63. INTEGER TINDIC(MI1,MI2,2)
  64. ENDSEGMENT
  65. *
  66. SEGMENT ICPR(nbpts)
  67. *
  68. segact mcoord
  69. C Operateur disponible en dimension 3
  70. IF (IDIM.NE.3) THEN
  71. INTERR(1)=IDIM
  72. CALL ERREUR(709)
  73. RETURN
  74. ENDIF
  75.  
  76. CANGLE=COS(XPI/9.D0)
  77. CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU)
  78. IF (IERR.NE.0) RETURN
  79. CALL LIRREE (ANGLE,0,IOK)
  80. * UN ANGLE ALPHA > 90› <==> XPI-ALPHA
  81. IF (IOK.NE.0) CANGLE=ABS(COS(ANGLE*XPI/180.D0))
  82. *--------------------------------------------------------------------
  83. *
  84. * ELIMINATION PARTIE MASSIVE
  85. *
  86. CALL ECROBJ('MAILLAGE',MELEME)
  87. CALL ENVVOL
  88. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  89. *--------------------------------------------------------------------
  90. *
  91. * CREATION STRUCTURE ESOPE
  92. *
  93. N1=200
  94. SEGINI TN
  95. INOR=0
  96. M1=200
  97. M2=10
  98. SEGINI TS
  99. ISEG=0
  100. MI1=200
  101. MI2=3
  102. SEGINI TI
  103. SEGINI ICPR
  104. LCPR=0
  105. *------------------------------------------------------------------
  106. * PREPARATION MAILLAGE
  107. *
  108. CALL ARETE1(MELEME,TS,ISEG,TN,INOR,TI,ICPR,LCPR)
  109. *------------------------------------------------------------------
  110. * ELIMINATION SEG2 INUTILE
  111. *
  112.  
  113. CALL ARETE3(TS,ISEG,TN,INOR,CANGLE,NBSEG)
  114.  
  115. NBNN=2
  116. NBELEM=NBSEG
  117. NBSOUS=0
  118. NBREF=0
  119. SEGINI MELEME
  120. ITYPEL=2
  121. J=1
  122. DO 100 I=1,ISEG
  123. IF (TSEG(I,1).EQ.1) THEN
  124. ICOLOR(J)=TSEG(I,2)
  125. NUM(1,J)=TSEG(I,3)
  126. NUM(2,J)=TSEG(I,4)
  127. J=J+1
  128. ENDIF
  129. 100 CONTINUE
  130. SEGDES MELEME
  131. SEGSUP TN,TS,TI,ICPR
  132. CALL ECROBJ('MAILLAGE',MELEME)
  133.  
  134. RETURN
  135.  
  136. END
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  

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