subroutine aptvubc (au, av, np, tol, bu, bv, vlen, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTVUBC
c
c call aptvubc (au, av, np, tol, bu, bv, vlen, nerr)
c
c Version: aptvubc Updated 1990 November 26 10:00.
c aptvubc Originated 1989 November 29 10:00.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the np unit vectors b = (bu, bv) parallel to the np
c vectors a = (au, av), all in the uv plane (2-D). If any
c components of the initial vector "a" are no greater than tol,
c or no greater than tol times the initial length of "a", then
c the corresponding component of "b" will be truncated to zero.
c If all are zero, or are truncated to zero, vlen will be zero.
c Flag nerr indicates any input error.
c
c With no truncation,
c (bu, bv) = (au, av) / sqrt (au**2 + av**2)
c
c History: 1990 March 14. Modified to always return a unit vector.
c
c Input: au, av, np, tol.
c
c Output: bu, bv, vlen, nerr.
c
c Glossary:
c
c au, av Input The u and v components of vector "a" in the uv plane.
c Size np.
c
c bu, bv Output The u and v components of vector "b" in the uv plane.
c Size np.
c A component will be zero if the corresponding
c component of vector "a" is no greater than tol,
c or no greater than tol times the length of "a".
c
c nerr Output Indicates an input error, it not 0.
c 1 if np is not positive.
c
c np Input Size of arrays au, av, bu, bv, vlen.
c
c tol Input Numerical tolerance limit.
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
c vlen Output Magnitude of vector "b", after any truncation of
c components has been done, but before division by
c vlen to form a unit vector. Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Component u of input vector "a".
dimension au (1)
c---- Component v of input vector "a".
dimension av (1)
c---- Component u of unit vector "b".
dimension bu (1)
c---- Component v of unit vector "b".
dimension bv (1)
c---- Magnitude of input vector "a".
dimension vlen (1)
c.... Local variables.
c---- Square of estimated error in "a".
common /laptvunp/ aerr2
c---- A very small number.
common /laptvunp/ fuz
c---- Index, 1 to np.
common /laptvunp/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvubc finding unit vectors with tol=',1pe13.5)
cbug 9902 format (i3,' au,av= ',1p2e22.14)
cbug write ( 3, 9901) tol
cbug write ( 3, 9902) (n, au(n), av(n), n = 1, np)
cbugc***DEBUG ends.
c.... Initialize.
c---- A very small number.
fuz = 1.e-99
nerr = 0
c.... Test for input errors.
if (np .le. 0) then
nerr = 1
go to 210
endif
c.... Find the unit vectors.
c---- No truncation.
if (tol .le. 0.0) then
c---- Loop over vectors.
do 110 n = 1, np
vlen(n) = sqrt (au(n)**2 + av(n)**2)
bu(n) = au(n) / (vlen(n) + fuz)
bv(n) = av(n) / (vlen(n) + fuz)
c---- End of loop over vectors.
110 continue
c---- Truncate small components to zero.
else
c---- Loop over vectors.
do 120 n = 1, np
aerr2 = tol**2 * amax1 (1.0, au(n)**2 + av(n)**2)
if (au(n)**2 .lt. aerr2) then
bu(n) = 0.0
else
bu(n) = au(n)
endif
if (av(n)**2 .lt. aerr2) then
bv(n) = 0.0
else
bv(n) = av(n)
endif
vlen(n) = sqrt (bu(n)**2 + bv(n)**2)
bu(n) = bu(n) / (vlen(n) + fuz)
bv(n) = bv(n) / (vlen(n) + fuz)
c---- End of loop over vectors.
120 continue
c---- Tested tol.
endif
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvubc results:' /
cbug & (i3,' bu,bv,len=',1p3e22.14))
cbug write ( 3, 9903) (n, bu(n), bv(n), vlen(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptvubc. (+1 line.)
end
UCRL-WEB-209832