subroutine aptvlim (au, av, aw, np, tolu, tolv, tolw, vlen, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTVLIM
c
c     call aptvlim (au, av, aw, np, tolu, tolv, tolw, vlen, nerr)
c
c     Version:  aptvlim  Updated    1990 January 18 16:40.
c               aptvlim  Originated 1989 December 19 13:40.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To adjust the np vectors a = (au, av, aw), by imposing the lower
c               limits tolu, tolv, and tolw on the magnitudes of the components
c               au, av, and aw, respectively, while retaining the initial
c               magnitude of the vector "a".  If all are initially zero, the
c               output vector "a" will be zero, and vlen will be zero.
c               Flag nerr indicates any input error.
c
c     Input:    au, av, aw, np, tolu, tolv, tolw.
c
c     Output:   au, av, aw, vlen, nerr.
c
c     Glossary:
c
c     au,av,aw  Input    The u, v, w components of input vector "a".  Size np.
c
c     au,av,aw  Output   The u, v, w components of output vector "a".  Size np.
c                          Magnitudes will be at least tolu, tolv, tolw,
c                          respectively, subject to the requirement that the
c                          final magnitude of vector "a" be the same as the
c                          initial magnitude.
c
c     nerr      Output   Indicates an input error, it not 0.
c                          1 if np is not positive.
c
c     np        Input    Size of arrays au, av, aw, vlen.
c
c     tolu      Input    Numerical tolerance limit for component au.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     tolv      Input    Numerical tolerance limit for component av.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     tolw      Input    Numerical tolerance limit for component aw.
c                          On Cray computers, recommend 1.e-5 to 1.e-11.
c
c     vlen      Output   Magnitude of vector "a".  Size np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Component u of vector "a".
      dimension au      (1)
c---- Component v of vector "a".
      dimension av      (1)
c---- Component w of vector "a".
      dimension aw      (1)
c---- Magnitude of vector "a".
      dimension vlen    (1)

c.... Local variables.

c---- Temporary magnitude of vector "a".
      common /laptvlim/ vlens

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

c---- Index, 1 to np.
      common /laptvlim/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptvlim limiting vectors with' /
cbug     &  '  tolu,v,w=  ',1p3e22.14)
cbug 9902 format (i3,' au,av,aw=',1p3e22.14)
cbug      write ( 3, 9901) tolu, tolv, tolw
cbug      write ( 3, 9902) (n, au(n), av(n), aw(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.... Impose the lower limits on the magnitudes of the vector components.

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

        vlen(n) = sqrt (au(n)**2 + av(n)**2 + aw(n)**2)

        au(n)   = sign (amax1 (tolu, abs (au(n))), au(n))
        av(n)   = sign (amax1 (tolv, abs (av(n))), av(n))
        aw(n)   = sign (amax1 (tolw, abs (aw(n))), aw(n))

        vlens   = sqrt (au(n)**2 + av(n)**2 + aw(n)**2)

        au(n)   = au(n) * vlen(n) / (vlens + fuz)
        av(n)   = av(n) * vlen(n) / (vlens + fuz)
        aw(n)   = aw(n) * vlen(n) / (vlens + fuz)

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

cbugc***DEBUG begins.
cbug 9903 format (/ 'aptvlim results:' /
cbug     &  (i3,' au,av,aw=',1p3e22.14 /
cbug     &  '    vlen=    ',1pe22.14))
cbug      write ( 3, 9903) (n, au(n), av(n), aw(n), vlen(n), n = 1, np)
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832