subroutine aptvang (ax, ay, az, bx, by, bz, np, tol, costh, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVANG
c
c     call aptvang (ax, ay, az, bx, by, bz, np, tol, costh, nerr)
c
c     Version:  aptvang  Updated    1994 October 31 16:00.
c               aptvang  Originated 1990 January 5 12:10.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find the cosine costh of the angle between the pair of
c               vectors a = (ax, ay, az) and b = (bx, by, bz), for each of np
c               sets of input data.  The value of costh will be truncated to
c               zero, if less than the estimated error in its calculation,
c               based on tol.  Flag nerr indicates any input error.
c
c     History:  1990 March 14.  Changed tol to 0.0 in call to unit vector
c               subroutine.  Allows small magnitudes.
c
c     Input:    ax, ay, az, bx, by, bz, np, tol.
c
c     Output:   costh, nerr.
c
c     Calls: aptvdoc, aptvunb 
c               
c
c     Glossary:
c
c     ax,ay,az  Input    The x, y, z components of a vector.  Size np.
c
c     bx,by,bz  Input    The x, y, z components of a vector.  Size np.
c
c     costh     Output   Cosine of the angle between the vectors "a" and "b".
c                          Will be truncated to zero, if less than the estimated
c                          error in its calculation, based on tol.  Size np.
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 ax, ay, az, bx, by, bz, costh.
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---- Component x of input vector "a".
      dimension ax      (1)
c---- Component y of input vector "a".
      dimension ay      (1)
c---- Component z of input vector "a".
      dimension az      (1)
c---- Component x of input vector "b".
      dimension bx      (1)
c---- Component y of input vector "b".
      dimension by      (1)
c---- Component z of input vector "b".
      dimension bz      (1)
c---- Cosine of angle between "a" and "b".
      dimension costh   (1)

c.... Local variables.

c---- Index in arrays.
      common /laptvang/ n
c---- First index of subset of data.
      common /laptvang/ n1
c---- Last index of subset of data.
      common /laptvang/ n2
c---- Size of current subset of data.
      common /laptvang/ ns
c---- Component x of unit vector "ua".
      common /laptvang/ uax     (64)
c---- Component y of unit vector "ua".
      common /laptvang/ uay     (64)
c---- Component z of unit vector "ua".
      common /laptvang/ uaz     (64)
c---- Component x of unit vector "ub".
      common /laptvang/ ubx     (64)
c---- Component y of unit vector "ub".
      common /laptvang/ uby     (64)
c---- Component z of unit vector "ub".
      common /laptvang/ ubz     (64)
c---- Magnitude of an input vector.
      common /laptvang/ vlen    (64)
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvang finding angles.',
cbug     &  '  np=',i3,', tol=',1pe13.5)
cbug 9902 format (i3,' ax,ay,az=',1p3e22.14 /
cbug     &  '    bx,by,bz=',1p3e22.14)
cbug      write ( 3, 9901) np, tol
cbug      write ( 3, 9902) (n, ax(n), ay(n), az(n), bx(n), by(n), bz(n),
cbug     &  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 unit vectors parallel to vectors "a" and "b".

      call aptvunb (ax(n1), ay(n1), az(n1), ns, 0.,
     &              uax, uay, uaz, vlen, nerr)

      call aptvunb (bx(n1), by(n1), bz(n1), ns, 0.,
     &              ubx, uby, ubz, vlen, nerr)

c.... Find the cosine of the angle between vectors "a" and "b".

      call aptvdot (uax, uay, uaz, ubx, uby, ubz, ns, tol,
     &              costh(n1), nerr)

      if (costh(n1) .lt. (-1.0 + tol)) costh(n1) = -1.0
      if (costh(n1) .gt. ( 1.0 - tol)) costh(n1) =  1.0

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 9903 format (/ 'aptvang cosines:')
cbug 9904 format (i3,' costh=   ',1pe22.14)
cbug      write ( 3, 9903)
cbug      write ( 3, 9904) (n, costh(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

c.... End of subroutine aptvang.      (+1 line.)
      end

UCRL-WEB-209832