1 : C APATET SOURCE CHAT 05/01/12 21:22:44 5004 2 : SUBROUTINE APATET(X,XELTET,IELEM,IFATET,IARTET,INOTET,TLI) 3 : C 4 : C********************************************************************** 5 : C 6 : C OBJET : CE SOUS-PROGRAMME RECHERCHE L'APPARTENANCE D'UN POINT 7 : C ----- A UN TETRAEDRE 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 XELTET = TABLEAU DES COORDONNEES DU TETRAEDRE 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 IARTET = 0 SI LE POINT N'APPARTIENT PAS A UNE ARETE 21 : C = N NUMERO DE L'ARETE SINON 22 : C INOTET = 0 SI LE POINT N'APPARTIENT PAS A UN NOEUD 23 : C = N NUMERO DU NOEUD SINON 24 : C 25 : C*********************************************************************** 26 : C 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : DIMENSION X(1),XELTET(3,1),NUARET(3,4),NUTL(3,4), 30 : * NUNOE(2,6),NFAC(4),TLI(4) 31 : C 32 : C 33 : DATA NUARET/ 1,3,6, 1,4,2, 6,4,5 ,2,5,3/ 34 : DATA NUTL / 4,2,1, 3,1,2, 3,4,2, 4,1,3 / 35 : DATA NUNOE/1,2, 1,3, 1,4, 2,3, 3,4, 4,2/ 36 : DATA NFAC /3,4,1,2/ 37 : C 38 : IDIM=3 39 : IELEM=0 40 : IFATET=0 41 : IARTET=0 42 : INOTET=0 43 : NOEU=4 44 : C EPS=1.D-5 45 : EPS=1.D-10 46 : UN=1.D0+EPS 47 : C 48 : C*** CALCUL DES COORDONNEES BARYCENTRIQUES 49 : C 49 : CALL COBAR4(X,XELTET,TLI) 50 : IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999 51 : IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999 52 : IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999 53 : IF(TLI(4).LT.-EPS.OR.TLI(4).GT.UN)GO TO 9999 54 : C 55 : C*** LE POINT APPARTIENT A L'ELEMENT 56 : C 57 : IELEM=1 58 : C*** RECHERCHE DE L'APPARTENANCE A UNE FACE 59 : C 60 : 60 CONTINUE 61 : C WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3),TLI(4) 62 : DO 70 I=1,NOEU 63 : IFATET=NFAC(I) 64 : VAL=ABS(TLI(I)) 65 : IF(VAL.LE.EPS) GO TO 80 66 : 70 CONTINUE 67 : IFATET=0 68 : GO TO 9999 69 : C 70 : C*** RECHERCHE DE L'APPARTENANCE A UNE ARETE DE LA FACE 71 : C 72 : 80 CONTINUE 73 : DO 90 I=1,3 74 : ILI=NUTL(I,IFATET) 75 : IARTET=NUARET(I,IFATET) 76 : VAL=ABS(TLI(ILI)) 77 : IF(VAL.LE.EPS) GO TO 100 78 : 90 CONTINUE 79 : IARTET=0 80 : GO TO 9999 81 : C 82 : C*** RECHERCHE DE L'APPARTENANCE A UN NOEUD DE L'ARETE 83 : C 84 : 100 CONTINUE 85 : DO 110 I=1,2 86 : INOTET=NUNOE(I,IARTET) 87 : VAL=ABS(TLI(INOTET)-1.) 88 : IF(VAL.LE.EPS) GO TO 9999 89 : 110 CONTINUE 90 : INOTET=0 91 : 9999 RETURN 92 : END 93 :
© Cast3M 2003 - All rights reserved.
Disclaimer