subroutine aptvusz (ax, ay, az, tol, ux, uy, uz, vlen) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTVUSZ c c call aptvusz (ax, ay, az, tol, ux, uy, uz, vlen) c c Version: aptvusz Updated 1991 July 30 17:00. c aptvusz Originated 1981 July 30 17:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find the unit vector u = (ux, uy, uz) parallel to the c vector a = (ax, ay, az). If any component of vector "a" c is no greater than tol, or no greater than tol times the length c of "a", then the corresponding component of "u" will be c truncated to zero. If all are zero, or are truncated to zero, c vlen will be zero. Flag nerr indicates any input error. c c With no truncation, c (ux, uy, uz) = (ax, ay, az) / sqrt (ax**2 + ay**2 + az**2). c c Input: ax, ay, az, tol. c c Output: ux, uy, uz, vlen. c c Glossary: c c ax,ay,az Input The x, y, z components of a vector. c c tol Input Numerical tolerance limit. c On Cray computers, recommend 1.e-5 to 1.e-11. c c ux,uy,uz Output The x, y, z components of a unit vector. c A component will be zero if the corresponding c component of vector "a" is no greater than tol, c or no greater than tol times the length of "a". c c vlen Output Magnitude of vector "u", after any truncation of c components has been done, but before division by c vlen to form a unit vector. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Local variables. c---- Square of estimated error in "a". common /laptvusz/ aerr2 c---- A very small number. common /laptvusz/ fuz cbugc***DEBUG begins. cbug 9901 format (/ 'aptvusz 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.... Find the unit vectors. c---- No truncation. if (tol .le. 0.0) then vlen = sqrt (ax**2 + ay**2 + az**2) ux = ax / (vlen + fuz) uy = ay / (vlen + fuz) uz = az / (vlen + fuz) c---- Truncate small components to zero. else aerr2 = tol**2 * amax1 (1.0, ax**2 + ay**2 + az**2) if (ax**2 .lt. aerr2) then ux = 0.0 else ux = ax endif if (ay**2 .lt. aerr2) then uy = 0.0 else uy = ay endif if (az**2 .lt. aerr2) then uz = 0.0 else uz = az endif vlen = sqrt (ux**2 + uy**2 + uz**2) ux = ux / (vlen + fuz) uy = uy / (vlen + fuz) uz = uz / (vlen + fuz) c---- Tested tol. endif cbugc***DEBUG begins. cbug 9903 format (/ 'aptvusz results:' / cbug & ' vlen= ',1pe22.14 / cbug & ' ux,uy,uz=',1p3e22.14) cbug write ( 3, 9903) vlen, ux, uy, uz cbugc***DEBUG ends. 210 return c.... End of subroutine aptvusz. (+1 line.) end UCRL-WEB-209832