Télécharger la plaquette Cast3M


fr en

Télécharger arete.eso

Retour à la liste

Numérotation des lignes : 

arete

  1. C ARETE     SOURCE    PV        21/12/19    21:15:02     11245          
  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.       if (ierr.ne.0) return
  90. *--------------------------------------------------------------------
  91. *
  92. *     CREATION STRUCTURE ESOPE
  93. *
  94.       N1=200
  95.       SEGINI TN
  96.       INOR=0
  97.       M1=200
  98.       M2=10
  99.       SEGINI TS
  100.       ISEG=0
  101.       MI1=200
  102.       MI2=3
  103.       SEGINI TI
  104.       SEGINI ICPR
  105.       LCPR=0
  106. *------------------------------------------------------------------
  107. *     PREPARATION MAILLAGE
  108. *
  109.       CALL ARETE1(MELEME,TS,ISEG,TN,INOR,TI,ICPR,LCPR)
  110.       if (ierr.ne.0) return
  111. *------------------------------------------------------------------
  112. *     ELIMINATION SEG2 INUTILE
  113. *
  114.  
  115.       CALL ARETE3(TS,ISEG,TN,INOR,CANGLE,NBSEG)
  116.       if (ierr.ne.0) return
  117.  
  118.       NBNN=2
  119.       NBELEM=NBSEG
  120.       NBSOUS=0
  121.       NBREF=0
  122.       SEGINI MELEME
  123.       ITYPEL=2
  124.       J=1
  125.       DO 100 I=1,ISEG
  126.          IF (TSEG(I,1).EQ.1) THEN
  127.             ICOLOR(J)=TSEG(I,2)
  128.             NUM(1,J)=TSEG(I,3)
  129.             NUM(2,J)=TSEG(I,4)
  130.             J=J+1
  131.          ENDIF
  132.  100  CONTINUE
  133.       SEGDES MELEME
  134.       SEGSUP TN,TS,TI,ICPR
  135.       CALL ECROBJ('MAILLAGE',MELEME)
  136.  
  137.       RETURN
  138.  
  139.       END
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  

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