subroutine apttinc (au, av, bu, bv, cu, cv, pu, pv, np,
     &                    tol, pab, pbc, pca, dpmin, nloc, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTTINC
c
c     call apttinc (au, av, bu, bv, cu, cv, pu, pv, np, tol,
c    &              pab, pbc, pca, dpmin, nloc, nerr)
c
c     Version:  apttinc  Updated    1990 December 3 16:20.
c               apttinc  Originated 1990 February 21 15: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 distances
c               pab, pbc and pca from the point p = (pu, pv) to the sides of
c               the triangle with vertices a = (au, av), b = (bu, bv) and
c               c = (cu, cv), in counterclockwise order in the uv plane, the
c               minimum dpmin of the distances pab, pbc and pca, and
c               whether point "p" is inside the triangle or not (flag nloc).
c               The values of pab, pbc and pca will be truncated to zero,
c               if less than the estimated error in their calculation, based on
c               tol.  Flag nerr indicates any input error.
c
c     Input:    au, av, bu, bv, cu, cv, pu, pv, np, tol.
c
c     Output:   pab, pbc, pca, dpmin, nloc, nerr.
c
c     Calls: aptptlc 
c
c     Glossary:
c
c     au, av    Input    The u, v coordinates of vertex "a" of the triangle.
c                          Size np.
c
c     bu, bv    Input    The u, v coordinates of vertex "b" of the triangle.
c                          Size np.
c
c     cu, cv    Input    The u, v coordinates of vertex "c" of the triangle.
c                          Size np.
c
c     dpmin     output   The minimum of the distances pab, pbc and pca.
c                          Size np.
c
c     nloc      Output   Indicates the location of point "p" relative to the
c                          triangle "abc":
c                          -1 if all triangle vertices coincide.
c                           0 if point "p" is outside the triangle "abc"
c                             (one or two of pab, pbc, pca are negative),
c                             or is inside, but the triangle vertices were
c                             specified in clockwise order (pab, pbc and pca
c                             are all non-positive).
c                           1 if point "p" is inside triangle "abc" (pab, pbc
c                             and pbc are all non-negative).
c                          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 pu, pv, au, av, bu, bv, cu, cv,
c                          pab, pbc, pca.
c
c     pab       Output   Distance from point "p" to triangle edge "ab".
c                          Truncated to zero, if less than the estimated error
c                          in its calculation, based on tol.  Size np.
c
c     pbc       Output   Distance from point "p" to triangle edge "bc".
c                          Truncated to zero, if less than the estimated error
c                          in its calculation, based on tol.  Size np.
c
c     pca       Output   Distance from point "p" to triangle edge "ca".
c                          Truncated to zero, if less than the estimated error
c                          in its calculation, based on tol.  Size np.
c
c     pu, pv    Input    The u and v coordinates of point "p" in the uv plane.
c                          Size np.
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 triangle vertex "a".
      dimension au      (1)
c---- Coordinate v of triangle vertex "a".
      dimension av      (1)
c---- Coordinate u of triangle vertex "b".
      dimension bu      (1)
c---- Coordinate v of triangle vertex "b".
      dimension bv      (1)
c---- Coordinate u of triangle vertex "c".
      dimension cu      (1)
c---- Coordinate v of triangle vertex "c".
      dimension cv      (1)
c---- The minimum of pab, pbc and pca.
      dimension dpmin   (1)
c---- 1 if point "p" is in triangle.
      dimension nloc    (1)
c---- Distance from point "p" to edge "ab".
      dimension pab     (1)
c---- Distance from point "p" to edge "bc".
      dimension pbc     (1)
c---- Distance from point "p" to edge "ca".
      dimension pca     (1)
c---- Coordinate u of point "p".
      dimension pu      (1)
c---- Coordinate v of point "p".
      dimension pv      (1)

c.... Local variables.

c---- Dummy argument.
      common /lapttinc/ fdmin
c---- Truncation error indicator.
      common /lapttinc/ itrunab (64)
c---- Truncation error indicator.
      common /lapttinc/ itrunbc (64)
c---- Truncation error indicator.
      common /lapttinc/ itrunca (64)
c---- Index in arrays.
      common /lapttinc/ n
c---- First index of subset of data.
      common /lapttinc/ n1
c---- Last index of subset of data.
      common /lapttinc/ n2
c---- Dummy argument.
      common /lapttinc/ nlim
c---- Index in external array.
      common /lapttinc/ nn
c---- Size of current subset of data.
      common /lapttinc/ ns
cbugc***DEBUG begins.
cbug 9901 format (/ 'apttinc finding if point in triangle:' /
cbug     &  (i3,' pu,pv=  ',1p2e22.14,' (point)' /
cbug     &  '    au,av=  ',1p2e22.14,' (vertices)' /
cbug     &  '    bu,bv=  ',1p2e22.14 /
cbug     &  '    cu,cv=  ',1p2e22.14))
cbug      write ( 3, 9901) (n, pu(n), pv, au(n), av(n),
cbug     &  bu(n), bv(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.... Set up the indices of the first subset of data.

      n1 = 1
      n2 = min (np, 64)

  110 ns = n2 - n1 + 1

c.... Find the distances from point "p" to the sides of the triangle "abc".

      call aptptlc (pu(n1), pv(n1), au(n1), av(n1), bu(n1), bv(n1),
     &              ns, tol, -1, pab(n1), fdmin, nlim, itrunab, nerr)

      call aptptlc (pu(n1), pv(n1), bu(n1), bv(n1), cu(n1), cv(n1),
     &              ns, tol, -1, pbc(n1), fdmin, nlim, itrunbc, nerr)

      call aptptlc (pu(n1), pv(n1), cu(n1), cv(n1), au(n1), av(n1),
     &              ns, tol, -1, pca(n1), fdmin, nlim, itrunca, nerr)

c.... Find if point "p" is inside the triangle "abc".

c---- Loop over subset of data.
      do 120 n = 1, ns

        nn        = n + n1 - 1
        if ((pab(nn) .ge. 0.0) .and.
     &      (pbc(nn) .ge. 0.0) .and.
     &      (pca(nn) .ge. 0.0)       ) then
          nloc(nn) = 1
        else
          nloc(nn) = 0
        endif

        if ((itrunab(n) .eq. -1) .and.
     &      (itrunbc(n) .eq. -1) .and.
     &      (itrunca(n) .eq. -1)       ) then
          nloc(nn) = -1
        endif

        dpmin(nn) = amin1 (pab(nn), pbc(nn), pca(nn))

c---- End of loop over subset of data.
  120 continue

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 (/ 'apttinc results:' /
cbug     &  (i3,' pab,bc,ca=',1p3e22.14 /
cbug     &  '    dpmin=    ',1pe22.14,' nloc=',i2))
cbug      write ( 3, 9902) (n, pab(n), pbc(n), pca(n), dpmin(n),
cbug     &  nloc(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832