subroutine aptpblc (au, av, bu, bv, np, tol,
& cu, cv, du, dv, dlen, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTPBLC
c
c call aptpblc (au, av, bu, bv, np, tol,
c & cu, cv, du, dv, dlen, nerr)
c
c Version: aptpblc Updated 1990 April 5 10:00.
c aptpblc Originated 1990 April 5 10:00.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the line which perpendicularly bisects the line through
c points a = (au, av) and b = (bu, bv), by passing through the
c point c = (cu, cv) on the midpoint of line "ab", in the
c direction d = (du, dv) perpendicular to the line "ab". The
c length of line "ab" and vector "d", dlen, is also returned.
c By convention, the direction of vector "d" is from right to
c left, relative to the direction from point "a" to point "b" in
c the uv plane. The components of vector "d" will be truncated to
c zero, if less than the estimated numerical error in their
c calculation, based on tol.
c Flag nerr indicates any input error, if not zero.
c
c Input: au, av, bu, bv, np, tol.
c
c Output: cu, cv, du, dv, dlen, nerr.
c
c Calls: aptvplc, aptvsuc
c
c
c Glossary:
c
c au, av Input The u and v coordinates of point "a". Size np.
c
c bu, bv Input The u and v coordinates of point "b". Size np.
c
c cu, cv Output The u and v coordinates of point "c" on the midpoint
c of line "ab". Size np. The line through point "c"
c with direction vector "d" is the perpendicular
c bisector of the line "ab".
c
c dlen Output The length of the line "ab" and the magnitude of the
c vector "d". Zero if points "a" and "b" are
c congruent, and the orientation of the bisecting line
c is indeterminate. Size np.
c
c du, dv Output The u and v components of vector "d" perpendicular to
c line "ab". Each component may be truncated to zero,
c if less than the estimated error in its calculation.
c Size np.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c
c np Input The number of lines "ab" for which the bisecting line
c is to be found. Must be positive.
c
c tol Input Numerical tolerance limit for du, dv.
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Coordinate u of input point "a".
dimension au (1)
c---- Coordinate v of input point "a".
dimension av (1)
c---- Coordinate u of input point "b".
dimension bu (1)
c---- Coordinate v of input point "b".
dimension bv (1)
c---- Coordinate u of center point "c".
dimension cu (1)
c---- Coordinate v of center point "c".
dimension cv (1)
c---- Magnitude of vector "d".
dimension dlen (1)
c---- Component u of vector "d".
dimension du (1)
c---- Component v of vector "d".
dimension dv (1)
c.... Local variables.
c---- Distance of point "c" from origin.
common /laptpblc/ clen (64)
c---- First index of subset of data.
common /laptpblc/ n1
c---- Last index of subset of data.
common /laptpblc/ n2
c---- Size of current subset of data.
common /laptpblc/ ns
cbugc***DEBUG begins.
cbugc---- Index in arrays.
cbug common /laptpblc/ n
cbug 9901 format (/ 'aptpblc finding line perpendicularly bisecting line',
cbug & ' through points:' /
cbug & (i3,' au,av=',1p2e22.14 /
cbug & ' bu,bv=',1p2e22.14))
cbug write ( 3, 9901) (n, au(n), av(n), bu(n), bv(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.... Set up the indices of the first subset of data.
n1 = 1
n2 = min (np, 64)
c.... Loop over subsets of data.
110 ns = n2 - n1 + 1
c.... Find the vector "d" perpendicular to line "ab", and its length.
call aptvplc (au(n1), av(n1), bu(n1), bv(n1), ns, tol,
& du(n1), dv(n1), dlen(n1), nerr)
c.... Find the midpoint of line "ab".
call aptvsuc (0, 0.5, au(n1), av(n1),
& 0.5, bu(n1), bv(n1), ns, tol,
& cu(n1), cv(n1), clen, nerr)
c.... See if all data subsets are done.
c---- Do another subset of data.
if (n2 .lt. np) then
n1 = n2 + 1
n2 = min (np, n1 + 63)
go to 110
endif
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptpblc results:' /
cbug & (i3,' dlen= ',1pe22.14 /
cbug & ' cu,cv=',1p2e22.14 /
cbug & ' du,dv=',1p2e22.14))
cbug write ( 3, 9902) (n, dlen(n), cu(n), cv(n),
cbug & du(n), dv(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptpblc. (+1 line.)
end
UCRL-WEB-209832