1 : C APAT67 SOURCE CHAT 05/01/12 21:22:39 5004 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(1),XELTRI(2,1),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 56 : CALL COBAR3(X,XEL3,TLI) 57 : C 58 : C 59 : IF(TLI(1).LT.-EPS.OR.TLI(1).GT.UN)GO TO 9999 60 : IF(TLI(2).LT.-EPS.OR.TLI(2).GT.UN)GO TO 9999 61 : IF(TLI(3).LT.-EPS.OR.TLI(3).GT.UN)GO TO 9999 62 : C 63 : C*** LE POINT APPARTIENT A L'ELEMENT 64 : C 65 : IELEM=1 66 : C 67 : C*** RECHERCHE DE L'APPARTENANCE A UNE ARETE 68 : C 69 : C WRITE(6,*)' TLI ',TLI(1),TLI(2),TLI(3) 70 : DO 80 I=1,NOEU 71 : IARTRI=IART(I) 72 : VAL=ABS(TLI(I)) 73 : IF(VAL.LE.EPS) GO TO 90 74 : 80 CONTINUE 75 : IARTRI=0 76 : GO TO 110 77 : C 78 : C*** RECHERCHE DE L'APPARTENANCE A UN NOEUD SOMMET DE L'ARETE 79 : C 80 : 90 CONTINUE 81 : DO 100 I=1,3 82 : IN=I 83 : VAL=ABS(TLI(IN)-1.) 84 : IF(VAL.GT.EPS) GO TO 100 85 : INOTRI=NOESOM(IN) 86 : GO TO 9999 87 : 100 CONTINUE 88 : INOTRI=0 89 : C 90 : C*** RECHERCHE SI C'EST LE NOEUD MILIEU DE L'ARETE 91 : C 92 : IJ=IARTRI 93 : VAL=ABS(TLI(IJ)-0.5) 94 : IF(VAL.GT.EPS) GO TO 9999 95 : INOTRI=NOEMIL((IART(IARTRI))) 96 : GO TO 9999 97 : C 98 : C*** RECHERCHE SI C'EST LE NOEUD CENTRAL POUR TRI7 99 : C 100 : 110 IF(NOET.LT.7) GO TO 9999 101 : UNTIER=1./3. 102 : VAL1=ABS(TLI(1)-UNTIER) 103 : VAL2=ABS(TLI(2)-UNTIER) 104 : IF(VAL1.GT.EPS.OR.VAL2.GT.EPS) GO TO 9999 105 : INOTRI=NOEMIL(4) 106 : 9999 RETURN 107 : END 108 :
© Cast3M 2003 - All rights reserved.
Disclaimer