subroutine aptvplc (au, av, bu, bv, np, tol, cu, cv, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVPLC
c
c     call aptvplc (au, av, bu, bv, np, tol, cu, cv, vlen, nerr)
c
c     Version:  aptvplc  Updated    1990 November 26 10:00.
c               aptvplc  Originated 1989 December 28 13:20.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find the vector c = (cu, cv) normal to the line defined by
c               the two points a = (au, av), b = (bu, bv), and in the uv plane,
c               for each of the np sets of points "a" and "b".  The directions
c               u, v, w are orthogonal.  The magnitude vlen of the normal vector
c               "c" is equal to the length of the line segment "ab".  If vlen is
c               zero, the points "a" and "b" are congruent.  By convention,
c               the direction of the normal vector is from right to left,
c               relative to the direction from "a" to "b" in the uv plane.
c               The components of "c" will be truncated to zero, if less than
c               the estimated numerical error in their calculation, based on
c               tol.  Flag nerr indicates any input error, if not zero.
c
c     Input:    au, av, bu, bv, np, tol.
c
c     Output:   cu, cv, vlen, nerr.
c
c     Glossary:
c
c     au, av    Input    The u and v coordinates of point "a".  Size np.
c
c     bu, bv    Input    The u and v coordinates of point "b".  Size np.
c
c     cu, cv    Output   The u and v components of normal vector "c".
c                          May be truncated to zero, if less than the estimated
c                          numerical error in their calculation.  See tol.
c
c     nerr      Output   Indicates an input error, if not 0.
c                          1 if np is not positive.
c
c     np        Input    The number of sets of points "a" and "b" for which the
c                          normal vector "c" is to be calculated.
c                          Must be positive.
c
c     tol       Input    Numerical tolerance limit for cu, cv.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     vlen      Output   The magnitude of the normal vector "c".  Size np.
c                          Zero if points "a" and "b" are congruent.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Coordinate u of input point "a".
      dimension au      (1)
c---- Coordinate v of input point "a".
      dimension av      (1)
c---- Coordinate u of input point "b".
      dimension bu      (1)
c---- Coordinate v of input point "b".
      dimension bv      (1)
c---- Component u of normal vector "c".
      dimension cu      (1)
c---- Component v of normal vector "c".
      dimension cv      (1)
c---- Magnitude of normal vector "c".
      dimension vlen    (1)

c.... Local variables.

c---- Index in arrays.
      common /laptvplc/ n
c---- Estimated error in cu.
      common /laptvplc/ cuerr
c---- Estimated error in cv.
      common /laptvplc/ cverr
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvplc finding normal vector to line',
cbug     &  ' through points:' /
cbug     &  (i3,' au,av=',1p2e22.14 /
cbug     &  '    bu,bv=',1p2e22.14))
cbug      write ( 3, 9901) (n, au(n), av(n), bu(n), bv(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 the normal vector "c", which is leftward from
c....  the direction of the line "ab" in the uv plane.

c---- Loop over lines.
      do 110 n = 1, np

        cu(n) = av(n) - bv(n)
        cv(n) = bu(n) - au(n)

c---- End of loop over lines.
  110 continue

c.... See if the components should be tested for numerical error.

c---- Test for numerical error.
      if (tol .gt. 0.0) then

c---- Loop over normal vectors.
        do 120 n = 1, np

          cuerr = tol * (abs (av(n)) + abs (bv(n)))
          if (abs (cu(n)) .lt. cuerr) then
            cu(n) = 0.0
          endif

          cverr = tol * (abs (au(n)) + abs (bu(n)))
          if (abs (cv(n)) .lt. cverr) then
            cv(n) = 0.0
          endif

c---- End of loop over normal vectors.
  120   continue

c---- Tested tol.
      endif

c.... Find the magnitudes of the normal vectors.

c---- Loop over normal vectors.
      do 130 n = 1, np
        vlen(n) = sqrt (cu(n)**2 + cv(n)**2)
c---- End of loop over normal vectors.
  130 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptvplc results:' /
cbug     &  (i3,' vlen= ',1pe22.14 /
cbug     &  '    cu,cv=',1p2e22.14))
cbug      write ( 3, 9902) (n, vlen(n), cu(n), cv(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832