1 : C TQ4LOC SOURCE CHAT 05/01/13 03:44:00 5004 2 : SUBROUTINE TQ4LOC (XE,BPSS,IRR) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC CCREEL 6 : ************************************************************************ 7 : * 8 : * T Q 4 L O C 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * 14 : * Calcul le repre local d'un {l{ment COQ4. 15 : * 16 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 17 : * ----------- 18 : * 19 : * XE (E) Coordonn{es des 4 noeuds. 20 : * BPSS (S) Matrice de passage. 21 : * IRR (S) =1 SUCCES ,=0 ECHEC 22 : REAL*8 XE(3,*),BPSS(3,*) 23 : * 24 : * VARIABLES: 25 : * ---------- 26 : * 27 : * QSI1 = vecteur norm{ de la m{diane allant de 4-1 vers 2-3. 28 : * ETA1 = vecteur norm{ de la m{diane allant de 1-2 vers 3-4. 29 : * X1, Y1 = vecteurs du rep}re local, dans le plan moyen de 30 : * l'{l{ment. 31 : * Z1 = vecteur du rep}re local, normal au plan moyen de 32 : * l'{l{ment. 33 : * 34 : REAL*8 QSI1(3),ETA1(3),X1(3),Y1(3),Z1(3) 35 : REAL*8 U1(3),V1(3) 36 : * 37 : * MODE DE FONCTIONNEMENT: 38 : * ----------------------- 39 : * 40 : * Pour le calcul du rep}re local et de la matrice de passage, on 41 : * fait une estimation du plan moyen. 42 : * 43 : * AUTEUR, DATE DE CREATION: 44 : * ------------------------- 45 : * 46 : * PASCAL MANIGOT 09 JUILLET 1991 47 : * 48 : * LANGAGE: 49 : * -------- 50 : * 51 : * FORTRAN77 52 : * 53 : ************************************************************************ 54 : * 55 : * 56 : * Calcul du rep}re local 57 : * ---------------------- 58 : * 59 : * Y 60 : * 4 | 3 61 : * *---|---------* 62 : * | | | 63 : * | | | 64 : * | | | 65 : * | +------------X 66 : * | | 67 : * *-------------* 68 : * 1 2 69 : * 70 : * 71 : IRR=1 72 : * Calcul des m{dianes: 73 : QSI1(1) = XE(1,2)+XE(1,3) - XE(1,1)-XE(1,4) 74 : QSI1(2) = XE(2,2)+XE(2,3) - XE(2,1)-XE(2,4) 75 : QSI1(3) = XE(3,2)+XE(3,3) - XE(3,1)-XE(3,4) 76 : XNORM=SQRT(QSI1(1)**2+QSI1(2)**2+QSI1(3)**2) 77 : IF(XNORM.GE.XPETIT)THEN 77 : CALL NORMER (QSI1) 78 : ELSE 79 : IRR=0 80 : RETURN 81 : ENDIF 82 : ETA1(1) = XE(1,3)+XE(1,4) - XE(1,1)-XE(1,2) 83 : ETA1(2) = XE(2,3)+XE(2,4) - XE(2,1)-XE(2,2) 84 : ETA1(3) = XE(3,3)+XE(3,4) - XE(3,1)-XE(3,2) 85 : XNORM=SQRT(ETA1(1)**2+ETA1(2)**2+ETA1(3)**2) 86 : IF(XNORM.GE.XPETIT)THEN 86 : CALL NORMER (QSI1) 87 : ELSE 88 : IRR=0 89 : RETURN 90 : ENDIF 90 : CALL NORMER (ETA1) 91 : * 92 : * Normale = Normale aux 2 m{dianes. 93 : Z1(1)= QSI1(2)*ETA1(3) - QSI1(3)*ETA1(2) 94 : Z1(2)= QSI1(3)*ETA1(1) - QSI1(1)*ETA1(3) 95 : Z1(3)= QSI1(1)*ETA1(2) - QSI1(2)*ETA1(1) 95 : CALL NORMER (Z1) 96 : * 97 : * Axes dans le Plan = bissectrices des bissectrices des m{dianes 98 : * = m{dianes pour un {l{ment rectangulaire 99 : U1(1) = QSI1(1) - ETA1(1) 100 : U1(2) = QSI1(2) - ETA1(2) 101 : U1(3) = QSI1(3) - ETA1(3) 101 : CALL NORMER (U1) 102 : V1(1) = QSI1(1) + ETA1(1) 103 : V1(2) = QSI1(2) + ETA1(2) 104 : V1(3) = QSI1(3) + ETA1(3) 104 : CALL NORMER (V1) 105 : * 106 : X1(1) = U1(1) + V1(1) 107 : X1(2) = U1(2) + V1(2) 108 : X1(3) = U1(3) + V1(3) 108 : CALL NORMER (X1) 109 : * 110 : Y1(1)=X1(3)*Z1(2)-X1(2)*Z1(3) 111 : Y1(2)=X1(1)*Z1(3)-X1(3)*Z1(1) 112 : Y1(3)=X1(2)*Z1(1)-X1(1)*Z1(2) 112 : CALL NORMER (Y1) 113 : * 114 : * Matrice de passage 115 : * ------------------ 116 : * 117 : DO 15 I=1,3 118 : BPSS(I,1)=X1(I) 119 : BPSS(I,2)=Y1(I) 120 : BPSS(I,3)=Z1(I) 121 : 15 CONTINUE 122 : * 123 : RETURN 124 : END 125 : 126 : 127 :
© Cast3M 2003 - All rights reserved.
Disclaimer