subroutine aptmove (nsys, iunit, au, av, aw, bu, bv, bw, dpmove,
& np, tol, cu, cv, cw, du, dv, dw, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTMOVE
c
c call aptmove (nsys, iunit, au, av, aw, bu, bv, bw, dpmove,
c & np, tol, cu, cv, cw, du, dv, dw, nerr)
c
c Version: aptmove Updated 1990 January 18 14:20.
c aptmove Originated 1989 November 22 17:10.
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 new
c point c = (cu, cv, cw) and unit direction vector
c d = (du, dv, dw), resulting from moving from the point
c a = (au, av, aw) in the direction of the unit vector
c b = (bu, bv, bw) for a distance dpmove.
c Option nsys specifies the coordinate system:
c 0 for Cartesian, 1 for cylindrical, 2 for spherical.
c Option iunit indicates the units for angles: 0 for degrees,
c 1 for radians.
c Any component of point "c" or vector "d" less than the
c estimated error in its calculation, based on tol, will be
c truncated to zero.
c Flag nerr indicates any input error.
c
c Input: nsys, iunit, au, av, aw, bu, bv, bw, dpmove, np, tol.
c
c Output: cu, cv, cw, du, dv, dw, nerr.
c
c Calls: aptcsyv, aptvadd
c
c
c Glossary:
c
c au,av,aw Input The u, v, w coordinates of point "a". Size np.
c
c bu,bv,bw Input The u, v, w components of unit vector "b". Size np.
c
c cu,cv,cw Output The u, v, w coordinates of point "c". Size np.
c May be truncated to zero, if less than the estimated
c numerical error in their calculation based on tol.
c
c dpmove Input The distance from point "a" to point "c". Size np.
c (Assuming vector "b" is a unit vector.)
c
c du,dv,dw Output The u, v, w components of unit vector "d". Size np.
c May be truncated to zero, if less than the estimated
c numerical error in their calculation based on tol.
c
c iunit Input Indicates unit to be used for angles:
c 0 if angles are in degrees.
c 1 if angles are in radians.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c 2 if nsys is not 1, 2, or 3.
c 3 if iunit is not 0 or 1.
c
c np Input Size of arrays.
c
c nsys Input Indicates coordinate system type:
c 0 for cartesian coordinates. u = x, v = y, w = z.
c 1 for cylindrical coordinates. u = radius from z
c axis, v = angle in xy plane, counterclockwise from
c x axis, w = z.
c 2 for spherical coordinates. u = radius from origin,
c v = angle in xy plane, counterclockwise from
c x axis, w = angle from z axis.
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---- Coordinate u of point "a".
dimension au (1)
c---- Coordinate v of point "a".
dimension av (1)
c---- Coordinate w of point "a".
dimension aw (1)
c---- Component u of unit vector "b".
dimension bu (1)
c---- Component v of unit vector "b".
dimension bv (1)
c---- Component w of unit vector "b".
dimension bw (1)
c---- Coordinate u of point "c".
dimension cu (1)
c---- Coordinate v of point "c".
dimension cv (1)
c---- Coordinate w of point "c".
dimension cw (1)
c---- The distance from "a" to "c".
dimension dpmove (1)
c---- Component u of unit vector "d".
dimension du (1)
c---- Component v of unit vector "d".
dimension dv (1)
c---- Component w of unit vector "d".
dimension dw (1)
c.... Local variables.
c---- Temporary coordinate u of point "a".
common /laptmove/ aus (64)
c---- Temporary coordinate v of point "a".
common /laptmove/ avs (64)
c---- Temporary coordinate w of point "a".
common /laptmove/ aws (64)
c---- Index in arrays.
common /laptmove/ n
c---- First index of subset of data.
common /laptmove/ n1
c---- Last index of subset of data.
common /laptmove/ n2
c---- Size of current subset of data.
common /laptmove/ ns
c---- Distance dpmove.
common /laptmove/ vlen (64)
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptmove initial point, distance and direction:' /
cbug & ' nsys=',i2,' iunit=',i2 /
cbug & (i3,' au,av,aw=',1p3e22.14 /
cbug & ' dpmove= ',1pe22.14 /
cbug & ' bu,bv,bw=',1p3e22.14))
cbug write ( 3, 9901) nsys, iunit, (n, au(n), av(n), aw(n), dpmove(n),
cbug & bu(n), bv(n), bw(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
if ((nsys .lt. 0) .or. (nsys .gt. 2)) then
nerr = 2
go to 210
endif
if ((iunit .lt. 0) .or. (iunit .gt. 1)) then
nerr = 3
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.... Store temporary values of point "a" and vector "b".
c---- Loop over subset of data.
do 120 n = 1, ns
aus(n) = au(n+n1-1)
avs(n) = av(n+n1-1)
aws(n) = aw(n+n1-1)
du(n+n1-1) = bu(n+n1-1)
dv(n+n1-1) = bv(n+n1-1)
dw(n+n1-1) = bw(n+n1-1)
c---- End of loop over subset of data.
120 continue
c.... See if conversion to Cartesian coordinates is needed.
c---- Convert point "a", vector "b".
if (nsys .ne. 0) then
call aptcsyv (nsys, 0, iunit, aus, avs, aws,
& du(n1), dv(n1), dw(n1), ns, tol, nerr)
endif
c.... Find point "c" (distance dpmove from point "a", in direction "b" = "d").
call aptvadd (aus, avs, aws, 1.0, dpmove(n1),
& du(n1), dv(n1), dw(n1), ns, tol,
& cu(n1), cv(n1), cw(n1), vlen, nerr)
c.... See if conversion back to the initial coordinates is needed.
c---- Convert point "c", vector "d".
if (nsys .ne. 0) then
call aptcsyv (0, nsys, iunit, cu(n1), cv(n1), cw(n1),
& du(n1), dv(n1), dw(n1), ns, tol, nerr)
endif
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 (/ 'aptmove results: new point and direction:' /
cbug & (i3,' cu,cv,cw=',1p3e22.14 /
cbug & ' du,dv,dw=',1p3e22.14))
cbug write ( 3, 9902) (n, cu(n), cv(n), cw(n),
cbug & du(n), dv(n), dw(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine aptmove. (+1 line.)
end
UCRL-WEB-209832