1 : C TRJPRI SOURCE CHAT 05/01/13 03:50:42 5004 2 : SUBROUTINE TRJPRI(IZNOEU,IZTRAV,IZAPAR,NPAPAR,J,IEL,INOELO,TLI, 3 : * ITRI ) 4 : C 5 : C********************************************************************** 6 : C 7 : C OBJET : CE SOUS-PROGRAMME CALCULE L'APPARTENANCE DE POINTS A UN 8 : C ----- ELEMENT PRISME D'UN MAILLAGE M1. 9 : C 10 : C ARGUMENTS: 11 : C --------- 12 : C 13 : C ENTREE : IZNOEU = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES 14 : C ET LES NUMEROS DES NOEUDS DE L ELEMENT COURANT 15 : C IZTRAV = POINTEUR DU SEGMENT CONTENANT LES COORDONNEES 16 : C DES POINTS DONT ON CHERCHE L'APPARTENANCE 17 : C IZAPAR = POINTEUR DU SEGMENT QUI CONTIENDRA LES 18 : C APPARTENANCES 19 : C NPAPAR = NOMBRE DE POINTS APPARTENANT A UN ELEMENT 20 : C IEL = NUMERO GLOBAL DE L'ELEMENT DANS LE MAILLAGE 21 : C J = NUMERO DU POINT TRAITE 22 : C ITRI = NUMERO DU TETRAEDRE ELEMENTAIRE DANS LE PRISME 23 : C 24 : C*********************************************************************** 25 : C 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8 (A-H,O-Z) 28 : DIMENSION TLI(*) 29 : DIMENSION XELTET(3,4),IDEPRI(4,3), 30 : * NUFACE(4,3),NUARET(6,3),X(3),NFACAR(6,3),NOEARE(6) 31 : C 32 : C 33 : SEGMENT IZAPAR 34 : INTEGER IAPAR(4,NPT2) 35 : ENDSEGMENT 36 : C 37 : SEGMENT IZTRAV 38 : REAL*8 COOR(NDIM,NPART) 39 : ENDSEGMENT 40 : SEGMENT IZNOEU 41 : REAL*8 XELE(IDIM,NOEL) 42 : INTEGER NOEGLO(NOEL) 43 : ENDSEGMENT 44 : C 45 : C 46 : C 47 : DATA IDEPRI/4,6,5,1, 6,5,1,3, 2,3,1,5/ 48 : DATA NUFACE/5,2,0,3, 4,0,0,5, 4,1,0,3/ 49 : DATA NUARET/2,4,7,6,0,0, 6,0,9,0,1,0, 5,3,8,1,0,0/ 50 : DATA NFACAR/5,3,5,4,3,5, 2,5,4,3,1,4, 1,1,3,1,3,4/ 51 : DATA NOEARE/1,3,5,2,4,6/ 52 : C 53 : IDIM=XELE(/1) 54 : NOEL=XELE(/2) 55 : INOELO=0 56 : C 57 : C*** DECOUPAGE DU PRISME EN 3 TETRAEDRES ET RECHERCHE DE L'APPARTENANCE 58 : C*** DES POINTS A CHACUN DES TETRAEDRES. 59 : C 60 : DO 40 I=1,3 61 : ITRI=I 62 : C 63 : C 64 : DO 20 K=1,4 65 : IN=IDEPRI(K,ITRI) 66 : DO 10 L=1,3 67 : XELTET(L,K)=XELE(L,IN) 68 : 10 CONTINUE 69 : 20 CONTINUE 70 : C 71 : C 72 : C 73 : IF(IAPAR(1,J).NE.0) GO TO 9999 74 : X(1)=COOR(1,J) 75 : X(2)=COOR(2,J) 76 : X(3)=COOR(3,J) 76 : CALL APATET(X,XELTET,IELEM,IFATET,IARTET,INOTET,TLI) 77 : IF(IELEM.EQ.0) GO TO 40 78 : C 79 : C--- LE POINT APPARTIENT A L'ELEMENT 80 : C 81 : NPAPAR=NPAPAR+1 82 : IAPAR(1,J)=IEL 83 : C 84 : C--- APPARTENANCE A UNE FACE DU PRISME 85 : C 86 : IF(IFATET.EQ.0) GO TO 9999 87 : IAPAR(2,J)=NUFACE(IFATET,ITRI) 88 : C 89 : C--- APPARTENANCE A UNE ARETE DU PRISME 90 : C 91 : IF(IARTET.EQ.0) GO TO 9999 92 : IARPRI=NUARET(IARTET,ITRI) 93 : IF(IAPAR(2,J).EQ.0.AND.IARTET.NE.0) 94 : * IAPAR(2,J)=NFACAR(IARTET,ITRI) 95 : IAPAR(3,J)=IARPRI 96 : C 97 : C--- APPARTENANCE A UN NOEUD DU PRISME 98 : C 99 : IF(INOTET.EQ.0) GO TO 9999 100 : INOELO=IDEPRI(INOTET,ITRI) 101 : IF(IAPAR(3,J).EQ.0) IAPAR(3,J)=NOEARE(INOELO) 102 : IARPRI=IAPAR(3,J) 103 : IF(IAPAR(2,J).EQ.0) IAPAR(2,J)=NFACAR(IARTET,ITRI) 104 : IAPAR(4,J)=NOEGLO(INOELO) 105 : GO TO 9999 106 : 40 CONTINUE 107 : 9999 CONTINUE 108 : RETURN 109 : END 110 :
© Cast3M 2003 - All rights reserved.
Disclaimer