Télécharger la plaquette Cast3M


fr en

Télécharger apat3.eso

Retour à la liste

Numérotation des lignes : 

apat3

  1. C APAT3     SOURCE    PV        22/04/15    13:20:05     11344          
  2.       SUBROUTINE APAT3(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 TRI3
  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 TRI3
  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              IARTRI = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE
  19. C                     = N NUMERO DE L'ARETE SINON
  20. C              INOTRI = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD
  21. C                     = N NUMERO DU NOEUD SINON
  22. C
  23. C***********************************************************************
  24. C
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8 (A-H,O-Z)
  27.       DIMENSION X(3),XELTRI(2,1),IART(3)
  28.       DIMENSION TLI(3)
  29. C
  30.       DATA IART/2,3,1/
  31. C                  IART numero local de l arete opose au noeud I
  32. C
  33.       IDIM=2
  34.       IELEM=0
  35.       IARTRI=0
  36.       INOTRI=0
  37.       NOEU=3
  38. C     EPS=1.D-5
  39.       EPS=1.D-10
  40.       UN=1.D0+EPS
  41. C
  42. C***  CALCUL DES COORDONNEES BARYCENTRIQUES
  43. C
  44.       CALL COBAR3(X,XELTRI,TLI)
  45. C
  46. C
  47.       IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999
  48.       IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999
  49.       IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999
  50. C           LE POINT APPARTIENT A L ELEMENT
  51.       IELEM=1
  52.  
  53. C***  RECHERCHE DE L'APPARTENANCE A UNE ARETE
  54. C
  55.       DO 50 I=1,NOEU
  56.       IARTRI=IART(I)
  57.       VAL=ABS(TLI(I))
  58.       IF(VAL.LE.EPS) GO TO 60
  59.    50 CONTINUE
  60.       IARTRI=0
  61.       GO TO 9999
  62. C
  63. C***  RECHERCHE DE L'APPARTENANCE A UN NOEUD DE L'ARETE
  64. C
  65.    60 CONTINUE
  66.       DO 70 I=1,3
  67.       INOTRI=I
  68.       VAL=ABS(TLI(INOTRI)-1.D0)
  69.       IF(VAL.LE.EPS) GO TO 9999
  70.    70 CONTINUE
  71.       INOTRI=0
  72.  9999 RETURN
  73.       END
  74.  
  75.  
  76.  

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