subroutine aptvunb (ax, ay, az, np, tol, ux, uy, uz, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVUNB
c
c     call aptvunb (ax, ay, az, np, tol, ux, uy, uz, vlen, nerr)
c
c     Version:  aptvunb  Updated    1990 November 26 10:00.
c               aptvunb  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 np unit vectors u = (ux, uy, uz) parallel to the
c               np vectors 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     History:  1990 March 14.  Modified to always return a unit vector.
c               1990 March 21.  Deleted change of 1990 March 14.
c
c     Input:    ax, ay, az, np, tol.
c
c     Output:   ux, uy, uz, vlen, nerr.
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z components of a vector.  Size np.
c
c     nerr      Output   Indicates an input error, it not 0.
c                          1 if np is not positive.
c
c     np        Input    Size of arrays ax, ay, az, ux, uy, uz, vlen.
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.  Size np.
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.  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Component x of input vector "a".
      dimension ax      (1)
c---- Component y of input vector "a".
      dimension ay      (1)
c---- Component z of input vector "a".
      dimension az      (1)
c---- Component x of unit vector "u".
      dimension ux      (1)
c---- Component y of unit vector "u".
      dimension uy      (1)
c---- Component z of unit vector "u".
      dimension uz      (1)
c---- Magnitude of input vector "a".
      dimension vlen    (1)

c.... Local variables.

c---- Square of estimated error in "a".
      common /laptvunb/ aerr2

c---- A very small number.
      common /laptvunb/ fuz

c---- Index, 1 to np.
      common /laptvunb/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvunb finding unit vectors with tol=',1pe13.5)
cbug 9902 format (i3,' ax,ay,az=',1p3e22.14)
cbug      write ( 3, 9901) tol
cbug      write ( 3, 9902) (n, ax(n), ay(n), az(n), n = 1, np)
cbugc***DEBUG ends.

c.... Initialize.

c---- A very small number.
      fuz = 1.e-99

      nerr = 0

c.... Test for input errors.

      if (np .le. 0) then
        nerr = 1
cbugc***DEBUG begins.
cbug        write ( 3, '(/ "aptvunb fatal.  bad np=",i3)') np
cbugc***DEBUG ends.
        go to 210
      endif

c.... Find the unit vectors.

c---- No truncation.
      if (tol .le. 0.0) then

c---- Loop over vectors.
        do 110 n = 1, np

          vlen(n) = sqrt (ax(n)**2 + ay(n)**2 + az(n)**2)
          ux(n)   = ax(n) / (vlen(n) + fuz)
          uy(n)   = ay(n) / (vlen(n) + fuz)
          uz(n)   = az(n) / (vlen(n) + fuz)

c---- End of loop over vectors.
  110   continue

c---- Truncate small components to zero.
      else

c---- Loop over vectors.
        do 120 n = 1, np

          aerr2   = tol**2 * amax1 (1.0, ax(n)**2 + ay(n)**2 + az(n)**2)

          if (ax(n)**2 .lt. aerr2) then
            ux(n) = 0.0
          else
            ux(n) = ax(n)
          endif

          if (ay(n)**2 .lt. aerr2) then
            uy(n) = 0.0
          else
            uy(n) = ay(n)
          endif

          if (az(n)**2 .lt. aerr2) then
            uz(n) = 0.0
          else
            uz(n) = az(n)
          endif

          vlen(n) = sqrt (ux(n)**2 + uy(n)**2 + uz(n)**2)
          ux(n)   = ux(n) / (vlen(n) + fuz)
          uy(n)   = uy(n) / (vlen(n) + fuz)
          uz(n)   = uz(n) / (vlen(n) + fuz)

c---- End of loop over vectors.
  120   continue

c---- Tested tol.
      endif
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvunb results:' /
cbug     &  (i3,' vlen=    ',1pe22.14 /
cbug     &  '    ux,uy,uz=',1p3e22.14))
cbug      write ( 3, 9903) (n, vlen(n), ux(n), uy(n), uz(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

c.... End of subroutine aptvunb.      (+1 line.)
      end

UCRL-WEB-209832