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