1 : C VECBAS SOURCE CHAT 05/01/13 04:04:42 5004 2 : c--------------------------------------------------------------------- 3 : c 4 : SUBROUTINE VECBAS (V1, V2, V3) 5 : c 6 : c===================================================================== 7 : c = 8 : c This routine calculates an orthonormal base from v1. = 9 : c = 10 : c Input : v1 (3) initial vector = 11 : c = 12 : c Output: v1 (3) unit vector = 13 : c v2 (3), v3 (3) unit vectors normal to v1 = 14 : c v1=v2xv3 ; v2=v3xv1 ; v3=v1xv2 = 15 : c = 16 : c===================================================================== 17 : IMPLICIT INTEGER(I-N) 18 : real*8 v1 (3), v2 (3), v3 (3) 19 : c 20 : real*8 toler, xn 21 : parameter (toler = 1.0 d-25) 22 : c 22 : call vecuni (3, v1, xn) 23 : c 24 : xn = v1 (1) **2 + v1 (2) **2 25 : if (xn .gt. toler) then 26 : xn = 1.0 d0 / SQRT (xn) 27 : c 28 : v2 (1) = -v1 (2) * xn 29 : v2 (2) = v1 (1) * xn 30 : v2 (3) = 0.0 d0 31 : v3 (1) = -v1 (3) * v2 (2) 32 : v3 (2) = v1 (3) * v2 (1) 33 : v3 (3) = v1 (1) * v2 (2) - v1 (2) * v2(1) 34 : else 35 : v2 (1) = 1.0 d0 36 : v2 (2) = 0.0 d0 37 : v2 (3) = 0.0 d0 38 : v3 (1) = 0.0 d0 39 : v3 (2) = 1.0 d0 40 : v3 (3) = 0.0 d0 41 : v1 (1) = 0.0 d0 42 : v1 (2) = 0.0 d0 43 : v1 (3) = 1.0 d0 44 : end if 45 : c 46 : return 47 : end 48 : 49 :
© Cast3M 2003 - All rights reserved.
Disclaimer