subroutine aptperc (au, av, bu, bv, pu, pv, np, tol,
& qx, dap, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTPERC
c
c call aptperc (au, av, bu, bv, pu, pv, np, tol, qx, dap, nerr)
c
c Version: aptperc Updated 1990 November 28 14:50.
c aptperc Originated 1990 October 1 13:40.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To project the np points p = (pu, pv) toward the view point
c a = (au, av), onto the line through the focal point
c b = (bu, bv) and perpendicular to the line "ab", and to
c find the distance dap from view point "a" to each point "p".
c The projected points will then be rotated and translated into
c the u axis, so that the origin is at point "b".
c The projection of each point "p" is point q = (qx).
c No points "p" behind the view point "a" will be projected.
c
c Flag nerr indicates any input error.
c
c Input: au, av, bu, bv, pu, pv, np, tol.
c
c Output: qx, dap, nerr.
c
c Calls: aptrotc, apttrac, aptvdic
c
c
c Glossary:
c
c au, av Input The u and v coordinates of the view point "a".
c
c bu, bv Input The u and v coordinates of focal point "b" on the
c projection line. The projection line is
c perpendicular to the line "ab", and will have
c its origin at point "b".
c Must be distinct from point "a".
c
c dap Output The distance from point "a" to point "p". Size np.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c 2 if the line "ab" is too short, based on tol.
c
c np Input Size of arrays pu, pv, qx, dap.
c
c pu, pv Input The u and v coordinates of point "p". Size np.
c No points "p" behind the view point "a", relative to
c the direction "ab", will be projected.
c
c qx Output The coordinate of the projection of point "p" on the
c line perpendicular to line "ab", measured from the
c origin at point "b". Size np.
c For points "p" behind point "a", relative to the
c direction "ab", point "q" will have a very large
c coordinate.
c
c tol Input Numerical tolerance limit.
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Distance from point "a" to point "p".
dimension dap (1)
c---- Coordinate u of point "p".
dimension pu (1)
c---- Coordinate v of point "p".
dimension pv (1)
c---- Coordinate x of point "q".
dimension qx (1)
c.... Local variables.
c---- Component u of vector "ab".
common /laptperc/ abu
c---- Component v of vector "ab".
common /laptperc/ abv
c---- A very big number.
common /laptperc/ big
c---- Distance between points "a" and "b".
common /laptperc/ dab
c---- A very small number.
common /laptperc/ fuz
c---- Index in arrays.
common /laptperc/ n
c---- First index of subset of data.
common /laptperc/ n1
c---- Last index of subset of data.
common /laptperc/ n2
c---- Index in external array.
common /laptperc/ nn
c---- Size of current subset of data.
common /laptperc/ ns
c---- Modified value of pu.
common /laptperc/ ppu (64)
c---- Modified value of pv.
common /laptperc/ ppv (64)
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptperc finding the view from point a:' /
cbug & ' au,av= ',1p2e22.14 /
cbug & ' looking in the direction of point b:' /
cbug & ' bu,bv= ',1p2e22.14 /
cbug & ' projected on the line thru b perpendicular to ab.' /
cbug & ' The points viewed are:' /
cbug & (i3,' pu,pv=',1p2e22.14))
cbug write ( 3, 9901) au, av, bu, bv,
cbug & (n, pu(n), pv(n), n = 1, np)
cbugc***DEBUG ends.
c.... Initialize.
c---- A very big number.
big = 1.e+99
c---- A very small number.
fuz = 1.e-99
nerr = 0
c.... Test for input errors.
if (np .le. 0) then
nerr = 1
cbugc***DEBUG begins.
cbug write ( 3, '("np = 0")')
cbugc***DEBUG ends.
go to 210
endif
c.... Find the vector "ab".
call aptvdic (au, av, bu, bv, 1, tol,
& abu, abv, dab, nerr)
if (dab .le. tol) then
nerr = 2
cbugc***DEBUG begins.
cbug write ( 3, '("Points a and b coincide.")')
cbugc***DEBUG ends.
go to 210
endif
c.... Set up the indices of the first subset of data.
n1 = 1
n2 = min (np, 64)
110 ns = n2 - n1 + 1
c.... Initialize temporary points "p".
c---- Loop over subset of data.
do 120 n = 1, ns
nn = n + n1 - 1
ppu(n) = pu(nn)
ppv(n) = pv(nn)
c---- End of loop over subset of data.
120 continue
cbugc***DEBUG begins.
cbug 9801 format (/ 'aptperc temporaries (initial):' /
cbug & (i3,' ppu,v=',1p2e22.14))
cbug write ( 3, 9801) (n, ppu(n), ppv(n), n = 1, np)
cbugc***DEBUG ends.
c.... Move the origin to point "a".
call apttrac (au, av, ppu, ppv, ns, tol, nerr)
c.... Rotate the vector "ab" to the u axis.
call aptrotc (abu, abv, 1., 0., ppu, ppv, ns, tol, nerr)
cbugc***DEBUG begins.
cbug 9802 format (/ 'aptperc temporaries (-a, ab onto z):' /
cbug & (i3,' ppu,v=',1p2e22.14))
cbug write ( 3, 9802) (n, ppu(n), ppv(n), n = 1, np)
cbugc***DEBUG ends.
c.... Find distance dap, and project points "p" onto the projection plane.
c.... Store the final coordinates of points "q".
c---- Loop over subset of data.
do 130 n = 1, ns
nn = n + n1 - 1
dap(nn) = sqrt (ppv(n)**2 + ppu(n)**2)
ppv(n) = dab * ppv(n) / (ppu(n) + fuz)
if (ppu(n) .lt. 0.0) then
ppv(n) = big
endif
qx(nn) = -ppv(n)
c---- End of loop over subset of data.
130 continue
cbugc***DEBUG begins.
cbug 9803 format (/ 'aptperc temporaries (projected):' /
cbug & (i3,' ppv =',1pe22.14))
cbug write ( 3, 9803) (n, ppv(n), n = 1, np)
cbugc***DEBUG ends.
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 (/ 'aptperc results:' /
cbug & (i3,' qx,ap=',1p2e22.14))
cbug write ( 3, 9902) (n, qx(n), dap(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptperc. (+1 line.)
end
UCRL-WEB-209832