subroutine aptvdot (ax, ay, az, bx, by, bz, np, tol, spab, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVDOT
c
c     call aptvdot (ax, ay, az, bx, by, bz, np, tol, spab, nerr)
c
c     Version:  aptvdot  Updated    1990 November 26 10:00.
c               aptvdot  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 scalar (dot) product spab of the np vector pairs
c               a = (ax, ay, az) and b = (bx, by, bz).  The value of spab
c               will be truncated to zero, if less than the estimated error
c               in its calculation, based on tol.
c               Flag nerr indicates any input error.
c
c               With no truncation, spab = ax * bx + ay * by + az * bz.
c
c     Input:    ax, ay, az, bx, by, bz, np, tol.
c
c     Output:   spab, nerr.
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z components of a vector.  Size np.
c
c     bx,by,bz  Input    The x, y, z components of a vector.  Size np.
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 ax, ay, az, bx, by, bz, spab.
c
c     spab      Output   Scalar product of vectors "a" and "b".  Will be
c                          truncated to zero, if less than the estimated error
c                          in its calculation, based on tol.  Size np.
c
c     tol       Input    Numerical tolerance limit.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
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 input vector "b".
      dimension bx      (1)
c---- Component y of input vector "b".
      dimension by      (1)
c---- Component z of input vector "b".
      dimension bz      (1)
c---- Input vector magnitude.
      dimension spab    (1)

c.... Local variables.

c---- Index, 1 to np.
      common /laptvdot/ n
c---- Estimated error in spab.
      common /laptvdot/ sperr
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvdot finding scalar products.',
cbug     &  '  np=',i3,', tol=',1pe13.5)
cbug 9902 format (i3,' ax,ay,az=',1p3e22.14 /
cbug     &  '    bx,by,bz=',1p3e22.14)
cbug      write ( 3, 9901) np, tol
cbug      write ( 3, 9902) (n, ax(n), ay(n), az(n), bx(n), by(n), bz(n),
cbug     &  n = 1, np)
cbugc***DEBUG ends.

c.... Initialize.

      nerr = 0

c.... Test for input errors.

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

c.... Find the scalar products.

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

        spab(n) = ax(n) * bx(n) + ay(n) * by(n) + az(n) * bz(n)

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

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

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

          sperr   = 2.0 * tol * (abs (ax(n) * bx(n)) +
     &              abs (ay(n) * by(n)) + abs (az(n) * bz(n)))
          if (abs (spab(n)) .lt. sperr) then
            spab(n) = 0.0
          endif

c---- End of loop over scalar products.
  120   continue

c---- Tested tol.
      endif
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvdot results:' /
cbug     &  (i3,' spab=    ',1pe22.14))
cbug      write ( 3, 9903) (n, spab(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832