subroutine aptvunz (ax, ay, az, tol, vlen) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTVUNZ c c call aptvunz (ax, ay, az, tol, vlen) c c Version: aptvunz Updated 1991 July 29 10:30. c aptvunz Originated 1981 July 29 10:30. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find the unit vector a = (ax, ay, az) parallel to the c initial vector a = (ax, ay, az). Any components of the c initial vector "a" no greater than tol, or no greater than tol c times the initial length of "a", will be truncated to zero. c If all are zero, or are truncated to zero, vlen will be zero. c c With no truncation, c (ax, ay, az) = (ax, ay, az) / sqrt (ax**2 + ay**2 + az**2). c c Input: ax, ay, az, tol. c c Output: ax, ay, az, vlen. c c Glossary: c c ax,ay,az Input The x, y, z components of input vector "a". c Will be truncated to zero if initially no greater c than tol, or no greater than tol times the initial c length of "a". c c ax,ay,az Output The x, y, z components of unit vector "a". c c tol Input Numerical tolerance limit. c On Cray computers, recommend 1.e-5 to 1.e-11. c c vlen Output Magnitude of the input vector "a", after any c truncation of components has been done, but before c division by vlen to form a unit vector. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Local variables. c---- Square of estimated error in "a". common /laptvunz/ aerr2 c---- A very small number. common /laptvunz/ fuz cbugc***DEBUG begins. cbug 9901 format (/ 'aptvunz finding unit vector with tol=',1pe13.5) cbug 9902 format (' ax,ay,az=',1p3e22.14) cbug write ( 3, 9901) tol cbug write ( 3, 9902) ax, ay, az cbugc***DEBUG ends. c.... Initialize. c---- A very small number. fuz = 1.e-99 c.... Test for the truncation option. c---- Truncate small components to zero. if (tol .gt. 0.0) then aerr2 = tol**2 * amax1 (1.0, ax**2 + ay**2 + az**2) if (ax**2 .lt. aerr2) then ax = 0.0 endif if (ay**2 .lt. aerr2) then ay = 0.0 endif if (az**2 .lt. aerr2) then az = 0.0 endif c---- Tested tol. endif c.... Find the unit vector. vlen = sqrt (ax**2 + ay**2 + az**2) ax = ax / (vlen + fuz) ay = ay / (vlen + fuz) az = az / (vlen + fuz) cbugc***DEBUG begins. cbug 9903 format (/ 'aptvunz results:' / cbug & ' vlen= ',1pe22.14 / cbug & ' ux,uy,uz=',1p3e22.14) cbug write ( 3, 9903) vlen, ax, ay, az cbugc***DEBUG ends. return c.... End of subroutine aptvunz. (+1 line.) end UCRL-WEB-209832