subroutine aptvadc (au, av, bmult, b, cu, cv, np, tol,
& du, dv, vlen, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTVADC
c
c call aptvadc (au, av, bmult, b, cu, cv, np, tol,
c & du, dv, vlen, nerr)
c
c Version: aptvadc Updated 1990 November 26 10:00.
c aptvadc Originated 1989 November 20 13:20.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find, for each of the np sets of input data, the 2-D vector
c sum d(n) = a(n) + bmult * b(n) * c(n), where d = (du, dv),
c a = (au, av), and c = (cu, cv), and to find vlen, the
c magnitude of vector "d", all in the uv plane.
c Any component of vector "d" less than the estimated error in
c its calculation, based on tol, will be truncated to zero.
c Flag nerr indicates any input error.
c
c History: 1990 February 22. Deleted truncation of vector components to
c zero based on vector magnitude.
c
c Input: au, av, bmult, b, cu, cv, np, tol.
c
c Output: du, dv, vlen, nerr.
c
c Glossary:
c
c au, av Input The u and v coordinates of point "a". Size np.
c The w components are zero. The directions u, v and w
c are orthogonal.
c
c b Input Coefficient of vector "c", when multiplied by bmult.
c Size np.
c
c bmult Input Multiplier of term b(n) * c(n). Not an array.
c
c cu, cv Input The u and v coordinates of point "c". Size np.
c The w components are zero.
c
c du, dv Output The u and v components of vector "d". Size np.
c The w components are zero.
c Will be truncated to zero if less than the estimated
c numerical error in their calculation based on tol.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c
c np Input Size of arrays au, av, b, cu, cv, vlen, du, dv.
c
c tol Input Numerical tolerance limit. Used to truncate
c the components of 2-D vector d = (du, dv).
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
c vlen Output Magnitude of vector "d". May be truncated to zero,
c if less than the estimated error in its calculation.
c See tol. Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Coordinate u of point "a".
dimension au (1)
c---- Coordinate v of point "a".
dimension av (1)
c---- A scalar multiplier.
dimension b (1)
c---- Coordinate u of point "c".
dimension cu (1)
c---- Coordinate v of point "c".
dimension cv (1)
c---- Component u of vector "d".
dimension du (1)
c---- Component v of vector "d".
dimension dv (1)
c---- The distance from "a" to "c".
dimension vlen (1)
c.... Local variables.
c---- Estimated error in du.
common /laptvadc/ duerr
c---- Estimated error in dv.
common /laptvadc/ dverr
c---- An array index.
common /laptvadc/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvadc finding vector sum a + b * c:' /
cbug & ' bmult= ',1pe22.14 /
cbug & (i3,' au,av= ',1p2e22.14 /
cbug & ' b= ',1pe22.14 /
cbug & ' cu,cv= ',1p2e22.14))
cbug write ( 3, 9901) bmult,
cbug & (n, au(n), av(n), b(n), cu(n), cv(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.... Find the components of vector "d".
c---- Loop over points or vectors.
do 110 n = 1, np
du(n) = au(n) + bmult * b(n) * cu(n)
dv(n) = av(n) + bmult * b(n) * cv(n)
c---- End of loop over points or vectors.
110 continue
c.... See if the truncation error option is to be used.
c---- Test and adjust du, dv.
if (tol .gt. 0.0) then
c---- Loop over points or vectors.
do 120 n = 1, np
duerr = tol * (abs (au(n)) + abs (bmult * b(n) * cu(n)))
if (abs (du(n)) .lt. duerr) then
du(n) = 0.0
endif
dverr = tol * (abs (av(n)) + abs (bmult * b(n) * cv(n)))
if (abs (dv(n)) .lt. dverr) then
dv(n) = 0.0
endif
c---- End of loop over points or vectors.
120 continue
c---- Tested tol.
endif
c.... Find the magnitudes of vector "d".
c---- Loop over points or vectors.
do 130 n = 1, np
vlen(n) = sqrt (du(n)**2 + dv(n)**2)
c---- End of loop over points or vectors.
130 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptvadc results:' /
cbug & (i3,' du,dv,len=',1p3e22.14))
cbug write ( 3, 9902) (n, du(n), dv(n), vlen(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptvadc. (+1 line.)
end
UCRL-WEB-209832