subroutine aptsclu (scale, bx, by, bz, px, py, pz, np, tol, & refm, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTSCLU c c call aptsclu (scale, bx, by, bz, px, py, pz, np, tol, c & refm, nerr) c c Version: aptsclu Updated 1990 March 13 16:00. c aptsclu Originated 1990 March 13 16:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find the matrix operator refm for uniform scaling by the c factor "scale", with the point b = (bx, by, bz) invariant, c and to do the scaling on the np points or vectors c p = (px, py, pz). The array size np may be 0. If "p" are c unbound vectors, invariant point "b" must be at the origin. c Flag nerr indicates any input error. c c Input: scale, bx, by, bz, px, py, pz, np, tol. c c Output: px, py, pz, refm, nerr. c c Calls: aptmopv c c c Glossary: 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 scale = 0.0. 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 Scale factor for uniform scaling. A negative value c is equivalent to a positive scaling, followed by c an inversion. A value of 0.0 is treated as an error. c c tol Input Numerical tolerance limit. Used to test and adjust c unit vector, matrix element, and point c components. c On Cray computers, 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---- Uniform scaling matrix operator. dimension refm (3,3) c.... Local variables. c.... (None.) cbugc***DEBUG begins. cbugc---- Row index of linear scaling matrix. cbug common /laptsclu/ i cbugc---- Column index of linear scaling matrix. cbug common /laptsclu/ j cbug 9901 format (/ 'aptsclu. Uniform scaling. tol=',1pe22.14 / cbug & ' scale= ',1pe22.14,' Invariant point:' / cbug & ' bx,by,bz=',1p3e22.14) cbug write ( 3, 9901) tol, scale, bx, by, bz cbugc***DEBUG ends. c.... Test for input errors. nerr = 0 if (scale .eq. 0.0) then nerr = 1 go to 210 endif c.... Form the components of the uniform scaling matrix. refm(1,1) = scale refm(1,2) = 0.0 refm(1,3) = 0.0 refm(2,1) = 0.0 refm(2,2) = scale refm(2,3) = 0.0 refm(3,1) = 0.0 refm(3,2) = 0.0 refm(3,3) = scale cbugc***DEBUG begins. cbug 9903 format (/ ' refm=',3(/ 1p3e22.14)) 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 aptsclu. (+1 line.) end UCRL-WEB-209832