subroutine aptvdis (ax, ay, az, bx, by, bz, np, tol,
     &                    dx, dy, dz, dab, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVDIS
c
c     call aptvdis (ax, ay, az, bx, by, bz, np, tol,
c    &              dx, dy, dz, dab, nerr)
c
c     Version:  aptvdis  Updated    1990 November 26 10:00.
c               aptvdis  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 distance vectors d = (dx, dy, dz) from the
c               points a = (ax, ay, az) to the points b = (bx, by, bz), and
c               their magnitudes, dab, the distances from "a" to "b".
c               Any component of vector "d" less than the estimated error in
c               its calculation, based on tol, will be truncated to zero.
c               Flag nerr indicates any input error.
c
c               With no truncation, (dx, dy, dz) = (bx, by, bz) - (ax, ay, az),
c               and distance dab = sqrt (dx**2 + dy**2 + dz**2).
c
c     History:  1990 February 22.  Deleted truncation of vector components to
c               zero based on vector magnitude.
c
c     Input:    ax, ay, az, bx, by, bz, np, tol.
c
c     Output:   dx, dy, dz, dab, nerr.
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z coordinates of point "a".  Size np.
c
c     bx,by,bz  Input    The x, y, z coordinates of point "b".  Size np.
c
c     dab       Output   Distance between points (ax, ay, az) and (bx, by, bz),
c                          the length of vector d = (dx, dy, dz).  May be
c                          truncated to zero, if less than the estimated error
c                          in its calculation.  See tol.  Size np.
c
c     dx,dy,dz  Output   The x, y, z components of vector "d".  Size np.
c                          May be truncated to zero, if less than the estimated
c                          numerical error in their calculation based on tol.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if np is not positive.
c
c     np        Input    The size of arrays ax, ay, az, bx, by, bz,
c                          dab, dx, dy, dz.
c
c     tol       Input    Numerical tolerance limit.  Used to truncate
c                          the components of vector d = (dx, dy, dz).
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Coordinate x of point "a".
      dimension ax      (1)
c---- Coordinate y of point "a".
      dimension ay      (1)
c---- Coordinate z of point "a".
      dimension az      (1)
c---- Coordinate x of point "b".
      dimension bx      (1)
c---- Coordinate y of point "b".
      dimension by      (1)
c---- Coordinate z of point "b".
      dimension bz      (1)
c---- the distance from "a" to "b".
      dimension dab     (1)
c---- Component x of vector "d".
      dimension dx      (1)
c---- Component y of vector "d".
      dimension dy      (1)
c---- Component z of vector "d".
      dimension dz      (1)

c.... Local variables.

c---- Estimated error in dx.
      common /laptvdis/ dxerr
c---- Estimated error in dy.
      common /laptvdis/ dyerr
c---- Estimated error in dz.
      common /laptvdis/ dzerr
c---- Index in "a", "b", "d", dab.
      common /laptvdis/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvdis finding distance between points:' /
cbug     &  (i3,' ax,ay,az=',1p3e22.14 /
cbug     &  '    bx,by,bz=',1p3e22.14))
cbug      write ( 3, 9901) (n, ax(n), ay(n), az(n),
cbug     &  bx(n), by(n), bz(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 components of the distance vectors.

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

        dx(n)  = bx(n) - ax(n)
        dy(n)  = by(n) - ay(n)
        dz(n)  = bz(n) - az(n)

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

c.... See if the truncation error option is to be used.

c---- Test and adjust dx, dy, dz.
      if (tol .gt. 0.0) then

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

          dxerr = tol * (abs (ax(n)) + abs (bx(n)))
          if (abs (dx(n)) .lt. dxerr) then
            dx(n) = 0.0
          endif

          dyerr = tol * (abs (ay(n)) + abs (by(n)))
          if (abs (dy(n)) .lt. dyerr) then
            dy(n) = 0.0
          endif

          dzerr = tol * (abs (az(n)) + abs (bz(n)))
          if (abs (dz(n)) .lt. dzerr) then
            dz(n) = 0.0
          endif

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

c---- Tested tol.
      endif

c.... Find the magnitudes of the distance vectors.

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

        dab(n) = sqrt (dx(n)**2 + dy(n)**2 + dz(n)**2)

c---- End of loop over points or vectors.
  130 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptvdis results:' /
cbug     &  (i3,' dab=     ',1pe22.14 /
cbug     &  '    dx,dy,dz=',1p3e22.14))
cbug      write ( 3, 9902) (n, dab(n), dx(n), dy(n), dz(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832