1 : C ROTVEC SOURCE CHAT 05/01/13 03:05:42 5004 2 : SUBROUTINE ROTVEC(VECT,OMEG,IDIM,KERRE) 3 : C----------------------------------------------------------------------- 4 : C ROUTINE DE ROTATION D'UN VECTEUR DANS L'HYPOTHESE DES PETITES 5 : C ROTATIONS 6 : C----------------------------------------------------------------------- 7 : C ENTREE 8 : C ------ VECT LE VECTEUR A REACTUALISER ( QUELCONQUE ) 9 : C OMEG LE VECTEUR ROTATION 10 : C IDIM INDICE DE LA DIMENSION ( 2 OU 3 ) 11 : C SORTIE 12 : C ------ VECT LE VECTEUR REACTUALISE ( NORME ) 13 : C KERRE INDICE D'ERREUR ( 0 SI TOUT EST OK ) 14 : C----------------------------------------------------------------------- 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : DIMENSION VECT(*),U(3),OMEG(*) 18 : C 19 : KERRE=0 20 : DO 1 I=1,IDIM 21 : 1 U(I)=VECT(I) 22 : C 23 : IF(IDIM.EQ.3) THEN 24 : VECT(1)=OMEG(2)*U(3)-OMEG(3)*U(2)+U(1) 25 : VECT(2)=OMEG(3)*U(1)-OMEG(1)*U(3)+U(2) 26 : VECT(3)=OMEG(1)*U(2)-OMEG(2)*U(1)+U(3) 27 : C 28 : ELSE IF (IDIM.EQ.2) THEN 29 : VECT(1)=-OMEG(1)*U(2)+U(1) 30 : VECT(2)= OMEG(1)*U(1)+U(2) 31 : ENDIF 32 : C 33 : XNOR=0.D0 34 : DO 2 I=1,IDIM 35 : 2 XNOR=XNOR+VECT(I)*VECT(I) 36 : IF(XNOR.EQ.0.D0) THEN 37 : KERRE=3 38 : RETURN 39 : ENDIF 40 : XNOR=1.D0/SQRT(XNOR) 41 : DO 3 I=1,IDIM 42 : 3 VECT(I)=VECT(I)*XNOR 43 : RETURN 44 : END 45 :
© Cast3M 2003 - All rights reserved.
Disclaimer