subroutine aptproc (au, av, rcir, pu, pv, np, tol, qu, qv, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTPROC
c
c     call aptproc (au, av, rcir, pu, pv, np, tol, qu, qv, nerr)
c
c     Version:  aptproc  Updated    1990 November 29 10:50.
c               aptproc  Originated 1990 October 3 9:30.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To project the np points p = (pu, pv) radially onto the
c               circle of radius rcir, centered at point a = (au, av).
c               The projected points are returned as q = (qu, qv).
c               Flag nerr indicates any input error.
c
c     Input:    au, av, rcir, pu, pv, np, tol.
c
c     Output:   qu, qv, nerr.
c
c     Calls: apttrac 
c
c     Glossary:
c
c     au, av    Input    The u and v coordinates of the center of the
c                          projection circle of radius rcir.
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, qu, qv.
c
c     pu, pv    Input    The u and v coordinates of point "p".  Size np.
c
c     qu, qv    Output   The u and v coordinates of the points projected from
c                          points "p" radially onto the circle of radius rcir
c                          centered at point "a".  Size np.
c                          Points "p" that coincide with point "a", based on
c                          tol, will be assigned very large "q" coordinates.
c
c     rcir      Input    The radius of the projection circle centered at point
c                          "a".
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 "p".
      dimension pu      (1)
c---- Coordinate v of point "p".
      dimension pv      (1)
c---- Coordinate u of point "q".
      dimension qu      (1)
c---- Coordinate v of point "q".
      dimension qv      (1)

c.... Local variables.

c---- A very big number.
      common /laptproc/ big

c---- Distance between points "a" and "p".
      common /laptproc/ dap

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

c---- Index in arrays.
      common /laptproc/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptproc projecting onto the circle at:' /
cbug     &  '  au,av=  ',1p2e22.14 /
cbug     &  '  with radius rcir=',1pe22.14 /
cbug     &  '  The points projected are:' /
cbug     &  (i3,' pu,pv=',1p2e22.14))
cbug      write ( 3, 9901) au, av, rcir, (n, pu(n), pv(n), n = 1, np)
cbugc***DEBUG ends.

c.... Initialize.

c---- A very big number.
      big = 1.e+99

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

      nerr = 0

c.... Test for input errors.

      if (np .le. 0) then
        nerr = 1
cbugc***DEBUG begins.
cbug      write ( 3, '(/ "np = 0")')
cbugc***DEBUG ends.
        go to 210
      endif

c.... Initialize projected points "q".

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

        qu(n) = pu(n)
        qv(n) = pv(n)

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

c.... Move the origin to point "a".

      call apttrac (au, av, qu, qv, np, tol, nerr)

c.... Project the points onto the circle of radius rcir centered at point "a".

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

        dap   = sqrt (qu(n)**2 + qv(n)**2)
        qu(n) = rcir * qu(n) / (dap + fuz)
        qv(n) = rcir * qv(n) / (dap + fuz)

        if (dap .le. tol) then
          qu(n) = big
          qv(n) = big
        endif

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

c.... Restore the origin to its original coordinates.

      call apttrac (-au, -av, qu, qv, np, tol, nerr)
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptproc results:' /
cbug     &  (i3,' qu,qv=',1p2e22.14))
cbug      write ( 3, 9902) (n, qu(n), qv(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832