subroutine aptdet3 (s, tol, det) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTDET3 c c call aptdet3 (s, tol, det) c c Version: aptdet3 Updated 2003 November 21 14:30. c aptdet3 Originated 2003 November 21 14:30. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find the determinant det of the 3x3 matrix s. c If the value of det is less than the estimated error in its c calculation, based on tol, det will be truncated to zero. c c If det is zero, one or more of the following are true: c one or more rows are all zero; c one or more columns are all zero; c two rows are equal or differ only by a common multiple; c two columns are equal or differ only by a common multiple; c a row is a linear combination of two or more other rows; c a column is a linear combination of two or more other column; c the four row vectors are all coplanar in three-space; c the four column vectors are all coplanar in three-space. c c Input: s. c c Output: det. c c Glossary: c c det Output The determinant of the 3x3 matrix s. c c s Input The 3x3 square matrix s. Double-subscripted, size 3x3. c c tol Input Numerical tolerance limit, if > 0. c For 64-bit floating point arithmetic, recommend c 1.e-5 to 1.e-11. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. real s(3,3) ! The 3x3 matrix s. c.... Local variables. real deterr ! The estimated error in det. cbugc***DEBUG begins. cbug integer i ! Row index in s. cbug integer j ! Column index in s. cbug 9901 format (/ 'aptdet3 finding determinant of 3x3 matrix. tol=', cbug & 1pe22.14 / (1p3e22.14)) cbug write ( 3, 9901) tol, ((s(i,j), j = 1, 3), i = 1, 3) cbugc***DEBUG ends. c.... Find the determinant det of the matrix s. det = s(1,1) * (s(2,2) * s(3,3) - s(2,3) * s(3,2)) + & s(1,2) * (s(2,3) * s(3,1) - s(2,1) * s(3,3)) + & s(1,3) * (s(2,1) * s(3,2) - s(2,2) * s(3,1)) c.... See if the result should be tested for truncation to zero. deterr = 0.0 if (tol .gt. 0.0) then ! Truncate small result to zero. deterr = 3.0 * tol * ( & abs (s(1,1)) * (abs (s(2,2) * s(3,3)) + & abs (s(2,3) * s(3,2))) + & abs (s(1,2)) * (abs (s(2,3) * s(3,1)) + & abs (s(2,1) * s(3,3))) + & abs (s(1,3)) * (abs (s(2,1) * s(3,2)) + & abs (s(2,2) * s(3,1)))) if (abs (det) .le. deterr) det = 0.0 endif ! Tested tol. cbugc***DEBUG begins. cbug 9902 format (/ 'aptdet3 results:' / cbug & ' det =',1pe22.14,' deterr =',1pe22.14) cbug write ( 3, 9902) det, deterr cbugc***DEBUG ends. return c.... End of subroutine aptdet3. (+1 line.) end UCRL-WEB-209832