subroutine aptrloc (wa, wb, wc, au, av, bu, bv, cu, cv, np, tol,
     &                    pu, pv, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTRLOC
c
c     call aptrloc (wa, wb, wc, au, av, bu, bv, cu, cv, np, tol,
c    &              pu, pv, nerr)
c
c     Version:  aptrloc  Updated    1990 December 3 14:20.
c               aptrloc  Originated 1990 May 16 17:40.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find, for each of np sets of vertex weights wa, wb and wc,
c               the point p = (pu, pv), interpolated between the vertices
c               a = (au, av), b = (bu, bv) and c = (cu, cv) of a
c               triangle in a major plane.
c
c                 p = (wa * a + wb * b + wc * c) / (wa + wb + wc).
c
c               Flag nerr indicates any input error.
c
c     Input:    wa, wb, wc, au, av, bu, bv, cu, cv, np, tol.
c
c     Output:   pu, pv, nerr.
c
c     Calls: None 
c
c     Glossary:
c
c     au, av    Input    The u and v coordinates of vertex "a" of triangle.
c                          Size np.
c
c     bu, bv    Input    The u and v coordinates of vertex "b" of triangle.
c                          Size np.
c
c     cu, cv    Input    The u and v coordinates of vertex "c" of triangle.
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 wa, wb, wc, au, av, bu, bv,
c                          cu, cv, pu, pv.
c
c     pu, pv    Output   Interpolated point "p".  Size np.  Coordinates may be
c                          truncated to zero, if less than the estimated error
c                          in their calculation, based on tol.
c
c     tol       Input    Numerical tolerance limit.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     wa        Input    Fractional distance of point "p" to vertex "a" from
c                          edge "bc", when normalized.  Size np.
c
c     wb        Input    Fractional distance of point "p" to vertex "b" from
c                          edge "ca", when normalized.  Size np.
c
c     wc        Input    Fractional distance of point "p" to vertex "c" from
c                          edge "ab", when normalized.  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Cooodinate u of point "a".
      dimension au      (1)
c---- Coordinate v of point "a".
      dimension av      (1)
c---- Cooodinate u of point "b".
      dimension bu      (1)
c---- Coordinate v of point "b".
      dimension bv      (1)
c---- Cooodinate u of point "c".
      dimension cu      (1)
c---- Coordinate v of point "c".
      dimension cv      (1)
c---- Cooodinate u of point "p".
      dimension pu      (1)
c---- Coordinate v of point "p".
      dimension pv      (1)
c---- Fractional distance to "a" from "bc".
      dimension wa      (1)
c---- Fractional distance to "b" from "ca".
      dimension wb      (1)
c---- Fractional distance to "c" from "ab".
      dimension wc      (1)

c.... Local variables.

c---- A very small number.
      common /laptrloc/ fuz

c---- Index in local array.
      common /laptrloc/ n
c---- First index of subset of data.
      common /laptrloc/ n1
c---- Last index of subset of data.
      common /laptrloc/ n2
c---- Index in external array.
      common /laptrloc/ nn
c---- Size of current subset of data.
      common /laptrloc/ ns
c---- Estimated error in pu.
      common /laptrloc/ puerr
c---- Estimated error in pv.
      common /laptrloc/ pverr
c---- Sum of wa + wb + wc.
      common /laptrloc/ sum
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptrloc interpolating in a triangle.' /
cbug     &  (i3,' wa,wb,wc=',1p3e22.14 /
cbug     &  '    au,av=',1p2e22.14 /
cbug     &  '    bu,bv=',1p2e22.14 /
cbug     &  '    cu,cv=',1p2e22.14))
cbug      write (3, 9901) (n, wa(n), wb(n), wc(n), au(n), av(n),
cbug     &  bu(n), bv(n), cu(n), cv(n), n = 1, np)
cbugc***DEBUG ends.

c.... initialize.

c---- A very small number.
      fuz = 1.e-99

      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 the data subsets.

  110 ns = n2 - n1 + 1

c.... Find the coordinates of the points.

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

        nn     = n + n1 - 1

        sum    = wa(nn) + wb(nn) + wc(nn)
        pu(nn) = (wa(nn) * au(nn) + wb(nn) * bu(nn) + wc(nn) * cu(nn)) /
     &           (sum + fuz)
        pv(nn) = (wa(nn) * av(nn) + wb(nn) * bv(nn) + wc(nn) * cv(nn)) /
     &           (sum + fuz)

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

c.... See if truncation allowed.

c---- Truncation to zero allowed.
      if (tol .gt. 0.0) then

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

          nn     = n + n1 - 1

          sum    = wa(nn) + wb(nn) + wc(nn)
          puerr  = tol * (abs (wa(nn) * au(nn)) +
     &                    abs (wb(nn) * bu(nn)) +
     &                    abs (wc(nn) * cu(nn))) / (sum + fuz)
          pverr  = tol * (abs (wa(nn) * av(nn)) +
     &                    abs (wb(nn) * bv(nn)) +
     &                    abs (wc(nn) * cv(nn))) / (sum + fuz)

          if (abs (pu(nn)) .lt. puerr) then
            pu(nn) = 0.0
          endif

          if (abs (pv(nn)) .lt. pverr) then
            pv(nn) = 0.0
          endif

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

c---- Tested tol.
      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 (/ 'aptrloc results:' /
cbug     &  (i3,' pu,pv=',1p2e22.14))
cbug      write ( 3, 9902) (n, pu(n), pv(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832