subroutine aptripp (ax, ay, az, bx, by, bz, cx, cy, cz, tol,
& dx, dy, dz, ex, ey, ez, fx, fy, fz, de,
& ux, uy, uz, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTRIPP
c
c call aptripp (ax, ay, az, bx, by, bz, cx, cy, cz, tol,
c & dx, dy, dz, ex, ey, ez, fx, fy, fz, de,
c & ux, uy, uz, nerr)
c
c Version: aptripp Updated 2001 April 30 14:00.
c aptripp Originated 2001 April 10 15:20.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: Given the triangle abc, with vertices a = (ax, ay, az),
c b = (bx, by, bz) and c = (cx, cy, cz), to find the equilateral
c triangle def whose vertices d = (dx, dy, dz), e = (ex, ey, ez)
c and f = (fx, fy, fz) are each in the direction normal to the
c plane of triangle abc from vertices a, b and c, respectively,
c and to find the edge length de of the equilateral triangles,
c and the unit vector u = (ux, uy, uz) perpendicular to the
c plane of triangle abc.
c Flag nerr indicates any input errors.
c
c Input: ax, ay, az, bx, by, bz, cx, cy, cz, tol.
c
c Output: dx, dy, dz, ex, ey, ez, fx, fy, fz, nerr, ux, uy, uz.
c
c Calls: aptripr, aptvadd, aptvdis, aptvxun
c
c Glossary:
c
c ax,ay,az Input The x, y and z coordinates of vertex a of triangle abc.
c
c bx,by,bz Input The x, y and z coordinates of vertex b of triangle abc.
c
c cx,cy,cz Input The x, y and z coordinates of vertex c of triangle abc.
c
c dx,dy,dz Output The x, y and z coordinates of vertex d of triangle def.
c
c ex,ey,ez Output The x, y and z coordinates of vertex e of triangle def.
c
c fx,fy,fz Output The x, y and z coordinates of vertex f of triangle def.
c
c de Output The length of the edges of the equilateral triangle.
c
c nerr Output Indicates an input error, if not 0.
c 1 if two or more of vertices a, b and c coincide.
c 2 if the method fails (impossible).
c
c tol Input Numerical tolerance limit.
c On computers with 64-bit floating point numbers,
c recommend 1.e-5 to 1.e-11.
c ux,uy,uz Output The x, y and z components of the unit vector
c perpendicular to the plane of triangle abc.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Specifications.
implicit none
c.... Arguments.
integer nerr ! Error indicator.
real ax, ay, az ! The x, y, z coordinates of vertex a.
real bx, by, bz ! The x, y, z coordinates of vertex b.
real cx, cy, cz ! The x, y, z coordinates of vertex c.
real de ! Length of edges of equilateral triangle.
real dx, dy, dz ! The x, y, z coordinates of vertex d.
real ex, ey, ez ! The x, y, z coordinates of vertex e.
real fx, fy, fz ! The x, y, z coordinates of vertex f.
real tol ! Numerical tolerence limit.
real ux, uy, uz ! The x, y, z components of unit normal.
c.... Local variables.
integer nerra ! Error indicator from apt calls.
real ab, bc, ca ! Lengths of edges ab, bc and ca.
real abx, aby, abz ! The x, y, z components of vector ab.
real bcx, bcy, bcz ! The x, y, z components of vector bc.
real cax, cay, caz ! The x, y, z components of vector ca.
real da, db, dc ! Distances vertices a, b, c projected.
real vlen ! The length of a vector.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptripp finding equilateral projection triangle.',
cbug & ' tol=',1pe22.14 /
cbug & ' ax,ay,az = ',1p3e22.14 /
cbug & ' bx,by,bz = ',1p3e22.14 /
cbug & ' cx,cy,cz = ',1p3e22.14 )
cbug write ( 3, 9901) tol, ax, ay, az, bx, by, bz, cx, cy, cz
cbugc***DEBUG ends.
c.... Initialize.
nerr = 0
de = -1.e99
dx = -1.e99
dy = -1.e99
dz = -1.e99
ex = -1.e99
ey = -1.e99
ez = -1.e99
fx = -1.e99
fy = -1.e99
fz = -1.e99
ux = -1.e99
uy = -1.e99
uz = -1.e99
c.... Find lengths of edges of triangle abc.
call aptvdis (ax, ay, az, bx, by, bz, 1, tol,
& abx, aby, abz, ab, nerra)
if (ab .eq. 0.0) then
nerr = 1
go to 410
endif
call aptvdis (bx, by, bz, cx, cy, cz, 1, tol,
& bcx, bcy, bcz, bc, nerra)
if (bc .eq. 0.0) then
nerr = 1
go to 410
endif
call aptvdis (cx, cy, cz, ax, ay, az, 1, tol,
& cax, cay, caz, ca, nerra)
if (ca .eq. 0.0) then
nerr = 1
go to 410
endif
c.... Find the equilateral triangle edge length and projection distances.
call aptripr (ab, bc, ca, tol, de, da, db, dc, nerra)
if (nerra .ne. 0) then
nerr = 2
go to 410
endif
c.... Find the unit vector normal to the plane of triangle abc.
call aptvxun (abx, aby, abz, bcx, bcy, bcz, 1, tol,
& ux, uy, uz, vlen, nerr)
c.... Find the coordinates of vertices d, e and f of the equilateral triangle.
call aptvadd (ax, ay, az, 1., da, ux, uy, uz, 1, tol,
& dx, dy, dz, vlen, nerra)
call aptvadd (bx, by, bz, 1., db, ux, uy, uz, 1, tol,
& ex, ey, ez, vlen, nerra)
call aptvadd (cx, cy, cz, 1., dc, ux, uy, uz, 1, tol,
& fx, fy, fz, vlen, nerra)
410 continue
cbugc***DEBUG begins.
cbug 9916 format (/ 'aptripp results. nerr = ',i2 /
cbug & ' dx,dy,dz = ',1p3e22.14 /
cbug & ' ex,ey,ez = ',1p3e22.14 /
cbug & ' fx,fy,fz = ',1p3e22.14 /
cbug & ' de = ',1pe22.14 /
cbug & ' ux,uy,uz = ',1p3e22.14 )
cbug write ( 3, 9916) nerr, dx, dy, dz, ex, ey, ez, fx, fy, fz, de,
cbug & ux, uy, uz
cbugc***DEBUG ends.
return
c.... End of subroutine aptripp. (+1 line.)
end
UCRL-WEB-209832