subroutine aptrips (ax, ay, az, bx, by, bz, cx, cy, cz, np, tol,
     &                    strip, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTRIPS
c
c     call aptrips (ax, ay, az, bx, by, bz, cx, cy, cz, np, tol,
c    &              strip, nerr)
c
c     Version:  aptrips  Updated    1995 November 20 15:40.
c               aptrips  Originated 1995 November 20 15:40.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find the scalar triple product strip of each of np vector
c               triples a = (ax, ay, az), b = (bx, by, bz) and c = (cx, cy, cz).
c               This is also the value of the determinant for which vectors
c               "a", "b" and "c" are either the row or column vectors.
c               The value of strip will be truncated to zero, if less than the
c               estimated error in its calculation, based on tol.
c               If strip is zero, the vectors are coplanar.
c               Flag nerr indicates any input error.
c
c               With no truncation,
c               strip = ax * (by * cz - bz * cy) +
c                       ay * (bz * cx - bx * cz) +
c                       az * (bx * cy - by * cx)
c
c               The scalar triple product of vectors "a", "b" and "c" is the
c               volume of a parallelopiped with edge vectors "a", "b" and "c"
c               at each vertex.
c
c     Input:    ax, ay, az, bx, by, bz, cx, cy, cz, np, tol.
c
c     Output:   strip, nerr.
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z components of input vector "a".  Size np.
c
c     bx,by,bz  Input    The x, y, z components of input vector "b".  Size np.
c
c     cx,cy,cz  Input    The x, y, z components of input vector "c".  Size np.
c
c     strip     Output   The scalar triple product of vectors "a", "b" and "c".
c                          Size np.  If strip is zero, vectors "a", "b" and
c                          "c" are coplanar.  Also, strip is the value of the
c                          3 by 3 determinant for which vectors "a", "b" and
c                          "c" are either the row or column vectors.
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, cx, cy, cz.
c
c     tol       Input    Numerical tolerance limit.
c                          For 64-bit floating point arithmetic, recommend
c                          1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      dimension ax      (1)           ! Component x of input vector "a".
      dimension ay      (1)           ! Component y of input vector "a".
      dimension az      (1)           ! Component z of input vector "a".
      dimension bx      (1)           ! Component x of input vector "b".
      dimension by      (1)           ! Component y of input vector "b".
      dimension bz      (1)           ! Component z of input vector "b".
      dimension cx      (1)           ! Component x of input vector "c".
      dimension cy      (1)           ! Component y of input vector "c".
      dimension cz      (1)           ! Component z of input vector "c".
      dimension strip   (1)           ! Scalar triple product of "a", "b", "c".

c.... Local variables.

      common /laptrips/ n             ! Index, 1 to np.
      common /laptrips/ striperr      ! Estimated error in strip.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptrips finding scalar triple product of vectors:' /
cbug     &  (i3,' ax,ay,az=',1p3e22.14 /
cbug     &  '    bx,by,bz=',1p3e22.14 /
cbug     &  '    cx,cy,cz=',1p3e22.14 ))
cbug      write ( 3, 9901) (n, ax(n), ay(n), az(n), bx(n), by(n), bz(n),
cbug     &  cx(n), cy(n), cz(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 triple products.

      do 110 n = 1, np                ! Loop over vectors.

        strip(n) = ax(n) * (by(n) * cz(n) - bz(n) * cy(n)) +
     &             ay(n) * (bz(n) * cx(n) - bx(n) * cz(n)) +
     &             az(n) * (bx(n) * cy(n) - by(n) * cx(n))

  110 continue                        ! End of loop over vectors.

c.... See if result should be tested for truncation to zero.

      if (tol .gt. 0.0) then          ! Truncate small result to zero.

        do 120 n = 1, np              ! Loop over vectors.

          striperr = 3.0 * tol *
     &      (abs (ax(n)) * (abs (by(n) * cz(n)) + abs (bz(n) * cy(n))) +
     &       abs (ay(n)) * (abs (bz(n) * cx(n)) + abs (bx(n) * cz(n))) +
     &       abs (az(n)) * (abs (bx(n) * cy(n)) + abs (by(n) * cx(n))))

          if (abs (strip(n)) .le. striperr) strip(n) = 0.0

  120   continue                      ! End of loop over vectors.

      endif                           ! Tested tol.
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptrips results:' /
cbug     &  (i3,' strip=   ',1pe22.14 ))
cbug      write ( 3, 9902) (n, strip(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832