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