subroutine aptvuac (au, av, np, tol, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVUAC
c
c     call aptvuac (au, av, np, tol, vlen, nerr)
c
c     Version:  aptvuac  Updated    1990 November 26 10:00.
c               aptvuac  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 = (au, av) parallel to the np
c               initial vectors a = (au, av), all in the uv plane (2-D).  Any
c               components of the initial vector "a" no greater than tol, or no
c               greater than tol times the initial length of "a", will be
c               truncated to zero.  If all are zero, or are truncated to zero,
c               vlen will be zero.
c               Flag nerr indicates any input error.
c
c               With no truncation,
c                 (au, av) = (au, av) / sqrt (au**2 + av**2)
c
c     History:  1990 March 14.  Modified to always return a unit vector.
c
c     Input:    au, av, np, tol.
c
c     Output:   au, av, vlen, nerr.
c
c     Glossary:
c
c     au, av    Input    The u and v components of initial vector "a" in the
c                          uv plane.  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     au, av    Output   The u and v components of unit vector "a" in the
c                          uv plane.  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 au, av, 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 u of vector "a".
      dimension au      (1)
c---- Component v of vector "a".
      dimension av      (1)
c---- Magnitude of input vector "a".
      dimension vlen    (1)

c.... Local variables.

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

c---- Index, 1 to np.
      common /laptvuac/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvuac finding unit vectors with tol=',1pe13.5)
cbug 9902 format (i3,' au,av=    ',1p2e22.14)
cbug      write ( 3, 9901) tol
cbug      write ( 3, 9902) (n, au(n), av(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, au(n)**2 + av(n)**2)
          if (au(n)**2 .lt. aerr2) then
            au(n) = 0.0
          endif
          if (av(n)**2 .lt. aerr2) then
            av(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 (au(n)**2 + av(n)**2)
        au(n)   = au(n) / (vlen(n) + fuz)
        av(n)   = av(n) / (vlen(n) + fuz)

c---- End of loop over vectors.
  120 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvuac results:' /
cbug     &  (i3,' au,av,len=',1p3e22.14))
cbug      write ( 3, 9903) (n, au(n), av(n), vlen(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832