subroutine aptvdoc (au, av, bu, bv, np, tol, spab, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVDOC
c
c     call aptvdoc (au, av, bu, bv, np, tol, spab, nerr)
c
c     Version:  aptvdoc  Updated    1990 November 26 10:00.
c               aptvdoc  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 2-D vectors
c               a = (au, av) and b = (bu, bv).  The value of spab will be
c               truncated to zero, if less than the estimated error in its
c               calculation, based on tol.
c               Flag nerr indicates any input error.
c
c               With no truncation, spab = au * bu + av * bv.
c
c     Input:    au, av, bu, bv, np, tol.
c
c     Output:   spab, nerr.
c
c     Glossary:
c
c     au, av    Input    The u and v components of a 2-D vector.  Size np.
c
c     bu, bv    Input    The u and v components of a 2-D 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 au, av, bu, bv, 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 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---- Input vector magnitude.
      dimension spab    (1)

c.... Local variables.

c---- Index, 1 to np.
      common /laptvdoc/ n
c---- Estimated error in spab.
      common /laptvdoc/ sperr
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvdoc finding scalar products.',
cbug     &  '  np=',i3,' tol=',1pe13.5)
cbug 9902 format (i3,' au,av=',1p2e22.14 /
cbug     &  '    bu,bv=',1p2e22.14)
cbug      write ( 3, 9901) np, tol
cbug      write ( 3, 9902) (n, au(n), av(n), bu(n), bv(n), n = 1, np)
cbugc***DEBUG ends.

c.... Initialize.

      nerr = 0

c.... Test for input errors.

      if (np .le. 0) then
        nerr = 1
        go to 210
      endif

c.... Find the scalar products.

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

        spab(n) = au(n) * bu(n) + av(n) * bv(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 (au(n) * bu(n)) +
     &              abs (av(n) * bv(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 (/ 'aptvdoc 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 aptvdoc.      (+1 line.)
      end

UCRL-WEB-209832