subroutine aptvuna (ax, ay, az, np, tol, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVUNA
c
c     call aptvuna (ax, ay, az, np, tol, vlen, nerr)
c
c     Version:  aptvuna  Updated    1990 November 26 10:00.
c               aptvuna  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 a = (ax, ay, az) parallel to the
c               np initial vectors a = (ax, ay, az).  Any components of the
c               initial vector "a" no greater than tol, or no greater than tol
c               times the initial length of "a", will be truncated to zero.
c               If all are zero, or are truncated to zero, vlen will be zero.
c               Flag nerr indicates any input error.
c
c               With no truncation,
c                 (ax, ay, az) = (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:   ax, ay, az, vlen, nerr.
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z components of input vector "a".  Size np.
c                          Will be truncated to zero if initially no greater
c                          than tol, or no greater than tol times the initial
c                          length of "a".
c
c     ax,ay,az  Output   The x, y, z components of unit vector "a".  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, vlen.
c
c     tol       Input    Numerical tolerance limit.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     vlen      Output   Magnitude of the input vector "a", after any
c                          truncation of components has been done, but before
c                          division by vlen to form a unit vector.  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

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

c.... Local variables.

c---- Square of estimated error in "a".
      common /laptvuna/ aerr2
c---- A very small number.
      common /laptvuna/ fuz

c---- Index, 1 to np.
      common /laptvuna/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvuna 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
        go to 210
      endif

c.... Test for the truncation option.

c---- Truncate small components to zero.
      if (tol .gt. 0.0) then

c---- Loop over vectors.
        do 110 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
            ax(n) = 0.0
          endif

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

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

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

c---- Tested tol.
      endif

c.... Find the unit vectors.

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

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

c---- End of loop over vectors.
  120 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvuna results:' /
cbug     &  (i3,' vlen=    ',1pe22.14 /
cbug     &  '    ux,uy,uz=',1p3e22.14))
cbug      write ( 3, 9903) (n, vlen(n), ax(n), ay(n), az(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832