Télécharger la plaquette Cast3M


fr en

Télécharger apat67.eso

Retour à la liste

Numérotation des lignes : 

apat67

  1. C APAT67    SOURCE    PV        18/06/20    21:15:01     9860           
  2.       SUBROUTINE APAT67(NOET,X,XELTRI,IELEM,IARTRI,INOTRI,TLI)
  3. C
  4. C**********************************************************************
  5. C
  6. C   OBJET  : CE SOUS-PROGRAMME RECHERCHE L'APPARTENANCE D'UN POINT
  7. C   -----    A UN TRI6 OU TRI7 DE REFERENCE.
  8. C
  9. C   ARGUMENTS:
  10. C   ---------
  11. C
  12. C   ENTREE  :  IDIM   = DIMENSION DE L'ESPACE
  13. C              X      = TABLEAU DES COORDONNEES DU POINT
  14. C              XELTRI = TABLEAU DES COORDONNEES DU TRI6 OU TRI7
  15. C
  16. C   SORTIE  :  IELEM  = 0 SI LE POINT N'APPARTIENT PAS A L'ELEMENT
  17. C                     = 1 SI LE POINT APPARTIENT A L'ELEMENT
  18. C              IFACE  = 0 SI LE POINT N'APPARTIENT PAS A UNE FACE
  19. C                     = N NUMERO DE LA FACE SINON
  20. C              IARTRI = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE
  21. C                     = N NUMERO DE L'ARETE SINON
  22. C              INOTRI = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD
  23. C                     = N NUMERO DU NOEUD SINON
  24. C              TLI    COORDONNEES BARYCENTRIQUES DU POINT X
  25. C
  26. C***********************************************************************
  27. C
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8 (A-H,O-Z)
  30.       DIMENSION X(*),XELTRI(2,*),NOEMIL(4),
  31.      *          XEL3(2,3),NOESOM(3),IART(3),TLI(*)
  32. C
  33. C
  34.       DATA NOEMIL/2,4,6,7/
  35.       DATA NOESOM/1,3,5/
  36.       DATA IART/2,3,1/
  37. C
  38.       IDIM=2
  39.       IELEM=0
  40.       IARTRI=0
  41.       INOTRI=0
  42.       NOEU=3
  43.       EPS=1.D-5
  44.       UN=1.D0+EPS
  45. C
  46. C***  CONSTRUCTION DE XEL3 COORDONNEES DES NOEUDS SOMMETS DU TRI3 ELEMEN
  47. C
  48.       DO 20 I=1,NOEU
  49.       I1=2*(I-1)+1
  50.       DO 10 J=1,IDIM
  51.       XEL3(J,I)=XELTRI(J,I1)
  52.    10 CONTINUE
  53.    20 CONTINUE
  54. C
  55. C***  CALCUL DES COORDONNEES BARYCENTRIQUES
  56. C
  57.       CALL COBAR3(X,XEL3,TLI)
  58. C
  59. C
  60.       IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999
  61.       IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999
  62.       IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999
  63. C
  64. C***  LE POINT APPARTIENT A L'ELEMENT
  65. C
  66.       IELEM=1
  67. C
  68. C***  RECHERCHE DE L'APPARTENANCE A UNE ARETE
  69. C
  70. C     WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3)
  71.       DO 80 I=1,NOEU
  72.       IARTRI=IART(I)
  73.       VAL=ABS(TLI(I))
  74.       IF(VAL.LE.EPS) GO TO 90
  75.    80 CONTINUE
  76.       IARTRI=0
  77.       GO TO 110
  78. C
  79. C***  RECHERCHE DE L'APPARTENANCE A UN NOEUD SOMMET DE L'ARETE
  80. C
  81.    90 CONTINUE
  82.       DO 100 I=1,3
  83.       IN=I
  84.       VAL=ABS(TLI(IN)-1.)
  85.       IF(VAL.GT.EPS) GO TO 100
  86.       INOTRI=NOESOM(IN)
  87.       GO TO 9999
  88.   100 CONTINUE
  89.       INOTRI=0
  90. C
  91. C***  RECHERCHE SI C'EST LE NOEUD MILIEU DE L'ARETE
  92. C
  93.       IJ=IARTRI
  94.       VAL=ABS(TLI(IJ)-0.5)
  95.       IF(VAL.GT.EPS) GO TO 9999
  96.       INOTRI=NOEMIL((IART(IARTRI)))
  97.       GO TO 9999
  98. C
  99. C***  RECHERCHE SI C'EST LE NOEUD CENTRAL POUR TRI7
  100. C
  101.   110 IF(NOET.LT.7) GO TO 9999
  102.       UNTIER=1./3.
  103.       VAL1=ABS(TLI(1)-UNTIER)
  104.       VAL2=ABS(TLI(2)-UNTIER)
  105.       IF(VAL1.GT.EPS.OR.VAL2.GT.EPS) GO TO 9999
  106.       INOTRI=NOEMIL(4)
  107.  9999 RETURN
  108.       END
  109.  
  110.  
  111.  

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