subroutine aptcirk (r1, r2, r3, tol, r4, r5,
& x1, y1, z1, x2, y2, z2, x3, y3, z3,
& x4, y4, z4, x5, y5, z5, nerr)
c.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCIRK
c
c call aptcirk (r1, r2, r3, tol, r4, r5,
c & x1, y1, z1, x2, y2, z2, x3, y3, z3,
c & x4, y4, z4, x5, y5, z5, nerr)
c
c Version: aptcirk Updated 2001 May 29 14:40.
c aptcirk Originated 1999 January 29 16:20.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: For the three coplanar and mutually tangent circles with radii
c r1, r2 and r3, find the radii r4 and r5 of two circles, each
c tangent to those three. Also find the coordinates of the
c centers of each of the 5 circles, with the first at the origin,
c the second on the positive x axis, and the others in the x-y
c plane.
c Flag nerr indicates any input or result error, if not zero.
c
c Method: See aptcirl, aptcirt.
c
c Input: r1, r2, r3, tol.
c
c Output: r4, r5, x1, y1, z1, x2, y2, z2, x3, y3, z3,
c x4, y4, z4, x5, y5, z5, nerr.
c
c Calls: aptcirl, aptcirt
c
c Glossary:
c
c nerr Output Indicates an input error, if not 0.
c -1 if the sign of y4 is uncertain.
c -2 if the sign of y5 is uncertain.
c -3 if the signs of y4 and y5 are uncertain.
c 1 if more than one radius is negative, or
c one is negative, but with a smaller magnitude than
c the sum of the other two radii.
c 2 if any of the radii are zero.
c 3 if r1 + r2 = 0.
c 4 if the center of circle 4 can not be found.
c 5 if the center of circle 5 can not be found.
c 6 if r4 and r5 can not be found.
c
c r1,r2,r3 Input The radii of three mutually tangent circles, all in
c the same plane. A negative radius indicates a circle
c that surrounds the other two circles. A very large
c radius, relative to the other two, indicates a
c straight line.
c
c r4 Output The radius of the circle coplanar with and tangent to
c the first three circles, in the space between them,
c if the first three radii are all positive.
c Returned as -1.e99 if nerr is positive.
c
c r5 Output The radius of another circle coplanar with and tangent
c to the first three circles. A negative value of r5
c means that circle surrounds the first four circles.
c A value of r5 near 1.e99 indicates the circumference
c of that circle is a straight line.
c Returned as -1.e99 if nerr is positive.
c
c x, y, z Output The x, y, z coordinates of the center of a circle.
c Returned for all five circles. See argument list.
c Returned as -1.e99 if nerr is positive.
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
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptcirk finding circles tangent to',
cbug & ' circles with radii:' /
cbug & ' r1, r2, r3 =',1p3e22.14 /
cbug & ' tol = ',1pe22.14 )
cbug write ( 3, 9901) r1, r2, r3, tol
cbugc***DEBUG ends.
c.... Initialize.
nerr = 0
r4 = -1.e99
r5 = -1.e99
x1 = -1.e99
y1 = -1.e99
z1 = -1.e99
x2 = -1.e99
y2 = -1.e99
z2 = -1.e99
x3 = -1.e99
y3 = -1.e99
z3 = -1.e99
x4 = -1.e99
y4 = -1.e99
z4 = -1.e99
x5 = -1.e99
y5 = -1.e99
z5 = -1.e99
c.... Test for impossible radii.
if (((r1 .lt. 0.0) .and. (-r1 .lt. (r2 + r3))) .or.
& ((r2 .lt. 0.0) .and. (-r2 .lt. (r3 + r1))) .or.
& ((r3 .lt. 0.0) .and. (-r3 .lt. (r1 + r2)))) then
nerr = 1
go to 210
endif
if (r1 * r2 * r3 .eq. 0.0) then
nerr = 2
go to 210
endif
s12 = r1 + r2
if (abs (s12) .le. tol * (abs (r1) + abs (r2))) s12 = 0.0
if (s12 .eq. 0.0) then
nerr = 3
go to 210
endif
c.... Find the radii of circles 4 and 5.
call aptcirt (r1, r2, r3, tol, r4, r5, nerra)
if (nerra .ne. 0) then
nerr = 6
go to 210
endif
c.... Find the coordinates of the centers of the first two circles.
x1 = 0.0
y1 = 0.0
z1 = 0.0
x2 = r1 + r2
errx2 = tol * (abs (r1) + abs (r2))
if (abs (x2) .le. errx2) x2 = 0.0
y2 = 0.0
z2 = 0.0
c.... Test for special case.
s = r1 + r2 + r3
errs = tol * (abs (r1) + abs (r2) + abs (r3))
if (abs (s) .le. errs) s = 0.0
if (s .eq. 0.0) then ! First three centers in a line.
x3 = r2
y3 = 0.0
z3 = 0.0
x4 = r4 - r1 + 2.0 * r1 * r4 / r2
errx4 = tol * (abs (r4) + abs (r1) + 2.0 * abs (r1 * r4 / r2))
if (abs (x4) .le. errx4) x4 = 0.0
y4 = 2.0 * r4
z4 = 0.0
x5 = r5 - r1 + 2.0 * r1 * r5 / r2
errx5 = tol * (abs (r5) + abs (r1) + 2.0 * abs (r1 * r5 / r2))
if (abs (x5) .le. errx5) x5 = 0.0
y5 = -2.0 * r5
z5 = 0.0
go to 210
endif ! Tested s.
c.... Find the coordinates of the center of circle 3.
call aptcirl (r1, r2, r3, tol, x3, y3, nerra)
if (nerra .ne. 0) then
nerr = 1
go to 210
endif
z3 = 0.0
c.... Find the coordinates of the center of circle 4.
call aptcirl (r1, r2, r4, tol, x4, y4, nerra)
if (nerra .ne. 0) then
nerr = 4
go to 210
endif
test1 = x3 * x4 + r3 * r4 - r1 * (r1 + r3 + r4)
test2 = y3 * y4
if (test1 * test2 .gt. 0.0) then
y4 = -y4
elseif (test1 * test2 .eq. 0.0) then
if (r4 .eq. r5) then
y4 = abs (y4)
elseif (y4 .ne. 0.0) then
nerr = nerr - 1
endif
endif
z4 = 0.0
c.... Find the coordinates of the center of circle 5.
call aptcirl (r1, r2, r5, tol, x5, y5, nerra)
if (nerra .ne. 0) then
nerr = 5
go to 210
endif
test1 = x3 * x5 + r3 * r5 - r1 * (r1 + r3 + r5)
test2 = y3 * y5
if (test1 * test2 .gt. 0.0) then
y5 = -y5
elseif (test1 * test2 .eq. 0.0) then
if (r5 .eq. r4) then
y5 = -y4
elseif (y5 .ne. 0.0) then
nerr = nerr - 2
endif
endif
z5 = 0.0
210 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptcirk results: nerr=',i3 /
cbug & ' r4, r5 = ',1p2e22.14 /
cbug & ' x1, y1, z1 =',1p3e22.14 /
cbug & ' x2, y2, z2 =',1p3e22.14 /
cbug & ' x3, y3, z3 =',1p3e22.14 /
cbug & ' x4, y4, z4 =',1p3e22.14 /
cbug & ' x5, y5, z5 =',1p3e22.14 )
cbug write ( 3, 9902) nerr, r4, r5, x1, y1, z1, x2, y2, z2,
cbug & x3, y3, z3, x4, y4, z4, x5, y5, z5
cbugc***DEBUG ends.
return
c.... End of subroutine aptcirk. (+1 line.)
end
UCRL-WEB-209832