subroutine aptqval (ax, ay, az, qc, qx, qy, qz, qxy, qyz, qzx,
     &                    qxx, qyy, qzz, tol, qval)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTQVAL
c
c     call aptqval (ax, ay, az, qc, qx, qy, qz, qxy, qyz, qzx,
c                   qxx, qyy, qzz, tol, qval)
c
c     Version:  aptqval  Updated    1998 April 7 16:50.
c               aptqval  Originated 1998 April 7 16:50.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find, for point "a" = (ax, ay, az), the value qval of the
c               quadric surface function f(ax,ay,az):
c
c                 f(x,y,z) = qc + qx * ax + qy * ay + qz * az +
c                            qxy * ax * ay + qyz * ay * az + qzx * az * ax +
c                            qxx * ax**2 + qyy * ay**2 + qzz * az**2.
c
c               Any result less than the estimated error in its calculation,
c               based on tol, will be truncated to zero.
c
c     Input:    ax, ay, az, qc, qx, qy, qz, qxy, qyz, qzx,
c               qxx, qyy, qzz, tol.
c
c     Output:   qval.
c
c     Calls: none 
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z coordinates of point "a".
c
c     qval      Output   The value of function f(x,y,z) at point "a",
c                          f(ax,ay,az).  Positive if on the side of the quadric
c                          surface where the normal vector points away from the
c                          surface.  Zero if point "a" is on the surface.
c     q..       Input    Coefficients of the implicit equation of a second-order
c                          surface in xyz space (qc, qx, qy, qz, qxy, qyz, qzx,
c                          qxx, qyy, qzz).
c
c     tol       Input    Numerical tolerance limit.
c                          On computers with 64-bit floating point words,
c                          recommend 1.e-5 to 1.e-15.
c
c     History:
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.


cbugc***DEBUG begins.
cbug 9901 format (/ 'aptqval finding the value at point "a" of the' /
cbug     &  ' quadric surface function with the coefficients qc-qzz:' /
cbug     &  ' ax, ay, az =',1p3e22.14 /
cbug     &  ' qc         =',1pe22.14 /
cbug     &  ' qx, qy, qz =',1p3e22.14 /
cbug     &  ' qxy,qyz,qzx=',1p3e22.14 /
cbug     &  ' qxx,qyy,qzz=',1p3e22.14 /
cbug     &  ' tol        =',1pe22.14 )
cbug      write ( 3, 9901)  ax, ay, az,
cbug     &  qc, qx, qy, qz, qxy, qyz, qzx, qxx, qyy, qzz, tol
cbugc***DEBUG ends.
cbug
c.... Find the value at point "a" of the quadric surface function f(ax,ay,az).

      qval = qc + qx * ax + qy * ay + qz * az +
     &       qxy * ax * ay +
     &       qyz * ay * az +
     &       qzx * az * ax +
     &       qxx * ax**2 + qyy * ay**2 + qzz * az**2

      qvas = qval

      qerr = tol * (abs (qc) +
     &       2.0 * (abs (qx * ax) + abs (qy * ay) + abs (qz * az)) +
     &       3.0 * (abs (qxy  * ax * ay) +
     &              abs (qyz  * ay * az) +
     &              abs (qzx  * az * ax) +
     &              abs (qxx) * ax**2 +
     &              abs (qyy) * ay**2 +
     &              abs (qzz) * az**2 ))

      if (abs (qval) .le. qerr) qval = 0.0

cbugc***DEBUG begins.
cbug 9905 format (/ 'aptqval results:' /
cbug     &  ' qvas       =',1pe22.14 /
cbug     &  ' qerr       =',1pe22.14 /
cbug     &  ' qval       =',1pe22.14 )
cbug      write ( 3, 9905) qvas, qerr, qval
cbugc***DEBUG ends.
cbug
cbug      return
cbug
cbugc.... End of subroutine aptqval.      (+1 line.)
      end

UCRL-WEB-209832