subroutine aptvxuc (au, av, bu, bv, np, tol, cw, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVXUC
c
c     call aptvxuc (au, av, bu, bv, np, tol, cw, vlen, nerr)
c
c     Version:  aptvxuc  Updated    1990 November 26 10:00.
c               aptvxuc  Originated 1989 December 29 11:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find, for each of the np sets of input data, the vector
c               (cross) product "a" x "b" of the pair of 2-D vectors
c               a = (au, av) and b = (bu, bv), and to divide bv its
c               magnitude vlen, to produce the unit vector c = (0.0, 0.0, cw),
c               parallel to "a" x "b".  If cw is less than the estimated error
c               in its calculation, based on tol, it will be truncated to zero,
c               and vlen will be zero.  Directions u, v and w are orthogonal.
c               Flag nerr indicates any input error.
c
c     Input:    au, av, bu, bv, np, tol.
c
c     Output:   cw, vlen, nerr.
c
c     Glossary:
c
c     au, av    Input    The u and v components of input vector "a".  Size np.
c                          The w components are zero.
c                          The unit vectors in the directions u, v and w form
c                          a positive unit triple.
c
c     bu, bv    Input    The u and v components of input vector "b".  Size np.
c                          The w components are zero.
c
c     cw        Output   The w components of output vector "c".  Size np.
c                          Will usually be +1.0 or -1.0.
c                          The u and v components are zero.
c                          Vector (cross) product of vectors "a" and "b",
c                          normalized to unit magnitude.  The value of cw will
c                          be truncated to zero if less than the estimated
c                          error in its calculation, based on tol.  This
c                          indicates that "a" and "b" are essentially parallel.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if np is not positive.
c
c     np        Input    Size of arrays au, av, bu, bv, cw, 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 vector product "a" x "b", after any
c                          truncation of components has been done.  Will be
c                          zero if all components of vector "c" are zero.
c                          Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Component u of input vector "a".
      dimension au      (1)
c---- Component v of input vector "a".
      dimension av      (1)
c---- Component u of input vector "b".
      dimension bu      (1)
c---- Component v of input vector "b".
      dimension bv      (1)
c---- Component w of output vector "c".
      dimension cw      (1)
c---- Magnitude of vector "a" x "b".
      dimension vlen    (1)

c.... Local variables.

c---- Estimated error in cw.
      common /laptvxuc/ cwerr

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

c---- Index, 1 to np.
      common /laptvxuc/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvxuc finding vector product of vectors:' /
cbug     &  (i3,' au,av=  ',1p2e22.14 /
cbug     &  '    bu,bv=  ',1p2e22.14))
cbug      write ( 3, 9901) (n, au(n), av(n), bu(n), bv(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.... Find the vector products (the u and v components are zero).

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

        cw(n)   = au(n) * bv(n) - av(n) * bu(n)

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

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

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

          cwerr   = 2.0 * tol * (abs (au(n) * bv(n)) +
     &                           abs (av(n) * bu(n)))
          if (abs (cw(n)) .lt. cwerr) then
            cw(n) = 0.0
          endif

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

c---- Tested tol.
      endif

c.... Find the vector lengths and unit vectors.

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

        vlen(n) = abs (cw(n))
        cw(n)   = cw(n) / (vlen(n) + fuz)

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

cbugc***DEBUG begins.
cbug 9902 format (/ 'aptvxuc results:' /
cbug     &  (i3,' vlen,cw=',1p2e22.14))
cbug      write ( 3, 9902) (n, vlen(n), cw(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832