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