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