1 : C POULOC SOURCE CHAT 05/01/13 02:19:14 5004 2 : SUBROUTINE POULOC(XEPOU,VECT,KERRE) 3 : C----------------------------------------------------------------------- 4 : C CALCUL DU VECTEUR LOCAL DE LA POUTRE PAR DEFAUT 5 : C 6 : C ENTREE 7 : C XEPOU COORDONNEES DES 2 NOEUDS 8 : C SORTIE 9 : C VECT VECTEUR DEFINISSANT LE REPERE LOCAL DE LA POUTRE 10 : C KERRE = 0 SI PAS DE PB 11 : C = 1 SI POINTS CONFONDUS 12 : C 13 : C----------------------------------------------------------------------- 14 : IMPLICIT INTEGER(I-N) 15 : IMPLICIT REAL*8(A-H,O-Z) 16 : DIMENSION XEPOU(3,*),P(3),VECT(*),A(3) 17 : C 18 : KERRE=0 19 : A(1)=XEPOU(1,2)-XEPOU(1,1) 20 : A(2)=XEPOU(2,2)-XEPOU(2,1) 21 : A(3)=XEPOU(3,2)-XEPOU(3,1) 22 : XL=SQRT(A(1)**2+A(2)**2+A(3)**2) 23 : IF(XL.EQ.0.D0) THEN 24 : KERRE=1 25 : RETURN 26 : ENDIF 27 : RL=1.D00/XL 28 : C 29 : C DEFINITION DU VECTEUR LOCAL PAR DEFAUT ( NON NORME ) 30 : C 31 : VECT(1)=-A(2)*RL 32 : VECT(2)=A(1)*RL 33 : VECT(3)=0.D00 34 : DO 7 I=1,3 35 : 7 P(I)=A(I)*RL 36 : RLP=0.D0 37 : DO 1 I=1,3 38 : 1 RLP=RLP+VECT(I)**2 39 : RLP= SQRT(RLP) 40 : C 41 : C TEST DE COLINEARITE 42 : C 43 : PROD=0.D00 44 : DO 4 I=1,3 45 : 4 PROD=PROD+VECT(I)*P(I) 46 : IF(ABS(PROD).LT.0.99D00*RLP) GO TO 5 47 : VECT(1)= 0.D0 48 : VECT(2)= -A(3)*RL 49 : VECT(3)= A(2)*RL 50 : C 51 : C ORTHOGONALISATION 52 : C 53 : 5 CONTINUE 54 : RLP=0.D00 55 : DO 6 I=1,3 56 : VECT(I)=VECT(I)-PROD*P(I) 57 : 6 RLP=RLP+VECT(I)**2 58 : RLP=1.D00/SQRT(RLP) 59 : DO 2 I=1,3 60 : 2 VECT(I)=VECT(I)*RLP 61 : RETURN 62 : END 63 :
© Cast3M 2003 - All rights reserved.
Disclaimer