subroutine aptscll (scale, ax, ay, az, bx, by, bz, px, py, pz, np,
& tol, refm, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTSCLL
c
c call aptscll (scale, ax, ay, az, bx, by, bz, px, py, pz, np,
c & tol, refm, nerr)
c
c Version: aptscll Updated 1990 March 14 16:00.
c aptscll Originated 1989 November 2 14:10.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the matrix operator refm for linear scaling with the
c factor scale, in the direction of the vector a = (ax, ay, az),
c with the point b = (bx, by, bz) invariant, and to do the
c scaling on the np points or vectors p = (px, py, pz), if np
c is positive. If p = (px, py, pz) are unbound vectors, make
c sure invariant point "b" is at the origin.
c This is the spatial part of a Lorentz transformation.
c Any components of refm within tol of -1.0, 0.0, or 1.0,
c will be truncated to those values.
c Flag nerr indicates any input error.
c
c History: 1990 March 14. Changed tol to 0.0 in call to unit vector
c subroutine. Allows small magnitudes.
c
c Input: scale, ax, ay, az, bx, by, bz, px, py, pz, np, tol.
c
c Output: px, py, pz, refm, nerr.
c
c Calls: aptvunb, aptmopv
c
c
c Glossary:
c
c ax,ay,az Input The x, y, z components of vector "a" in the direction
c of linear scaling.
c
c bx,by,bz Input The x, y, z coordinates of invariant point "b".
c
c nerr Output Indicates an input error, if not 0.
c 1 if the magnitude of vector "a" is too
c small, relative to tol.
c
c np Input Number of points or vectors "p". May be 0.
c
c px,py,pz In/Out The x, y, z coordinates or components of point or
c vector "p", before and after scaling. Size np.
c
c refm Output Linear scaling operator (a unitary 3 x 3 matrix).
c Must be sized refm(3,3).
c
c scale Input Linear scaling factor. A negative value is equivalent
c to a positive linear scaling, followed by a
c reflection in the plane with the normal vector "a".
c
c tol Input Numerical tolerance limit. Used to test and adjust
c unit vector, matrix element, and point components.
c On computers with 64-bit floating point numbers,
c recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Coordinate or component x. Size np.
dimension px (1)
c---- Coordinate or component y. Size np.
dimension py (1)
c---- Coordinate or component z. Size np.
dimension pz (1)
c---- Linear scaling matrix operator.
dimension refm (3,3)
c.... Local variables.
c---- Row index of linear scaling matrix.
common /laptscll/ i
c---- Column index of linear scaling matrix.
common /laptscll/ j
c---- Component x of unit normal vector.
common /laptscll/ ux
c---- Component y of unit normal vector.
common /laptscll/ uy
c---- Component z of unit normal vector.
common /laptscll/ uz
c---- Magnitude of a vector.
common /laptscll/ vlen
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptscll. Linear scaling by factor scale=',1pe22.14 /
cbug & ' in direction ax,ay,az=' / 5x,1p3e22.14 /
cbug & ' with invariant point bx,by,bz=' / 5x,1p3e22.14)
cbug write ( 3, 9901) scale, ax, ay, az, bx, by, bz
cbugc***DEBUG ends.
c.... Initialize.
nerr = 0
c.... Find the unit vector in the direction of the vector "a".
call aptvunb (ax, ay, az, 1, 0., ux, uy, uz, vlen, nerr)
c---- Vector magnitude too small.
if (vlen .le. tol) then
nerr = 1
go to 210
endif
c.... Form the components of the linear scaling matrix.
refm(1,1) = 1.0 + (scale - 1.0) * ux**2
refm(1,2) = + (scale - 1.0) * ux * uy
refm(1,3) = + (scale - 1.0) * ux * uz
refm(2,1) = + (scale - 1.0) * ux * uy
refm(2,2) = 1.0 + (scale - 1.0) * uy**2
refm(2,3) = + (scale - 1.0) * uy * uz
refm(3,1) = + (scale - 1.0) * ux * uz
refm(3,2) = + (scale - 1.0) * uy * uz
refm(3,3) = 1.0 + (scale - 1.0) * uz**2
c---- Adjust components near 0 or 1.
if (tol .gt. 0.0) then
do 120 i = 1, 3
do 110 j = 1, 3
if (abs (refm(i,j)) .le. tol) then
refm(i,j) = 0.0
elseif ((abs (abs (refm(i,j)) - 1.0)) .le. tol) then
refm(i,j) = sign (1.0, refm(i,j))
endif
110 continue
120 continue
c---- Tested tol.
endif
cbugc***DEBUG begins.
cbug 9902 format (' ux,uy,uz=',1p3e22.14)
cbug 9903 format (/ ' refm=',3(/ 1p3e22.14))
cbug write ( 3, 9902) ux, uy, uz
cbug write ( 3, 9903) ((refm(i,j), j = 1, 3), i = 1, 3)
cbugc***DEBUG ends.
c.... Do the linear scaling operation on the np points or vectors "p".
c---- Scale the points or vectors.
if (np .gt. 0) then
call aptmopv (refm, 0, bx, by, bz, px, py, pz, np, tol, nerr)
c---- Tested np.
endif
210 return
c.... End of subroutine aptscll. (+1 line.)
end
UCRL-WEB-209832