subroutine aptscmz (au, av, aw, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTSCMZ
c
c     call aptscmz (au, av, aw, nerr)
c
c     Version:  aptscmz  Updated    1991 August 5 14:00.
c               aptscmz  Originated 1991 August 5 14:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To randomly sample a unit direction vector a = (au, av, aw)
c               from a cone at an angle phi from the u axis in 3-D space,
c               where phi = arccos (au).  Flag nerr indicates any error
c               in the input data.
c
c     Input:    au.
c
c     Output:   av, aw, nerr.
c
c     Glossary:
c
c     au        Input    The cosine of the angle between the u axis and the
c                          randomly sampled unit vector "a".  Must be between
c                          -1.0 and 1.0.
c
c     av, aw    Output   The v and w components of a unit vector sampled
c                          randomly from all directions in space that are at
c                          angle phi = arccos (au) from the u axis.
c
c     nerr      Output   Indicates an input error, if not zero.
c                          1 if au is not between -1.0 and 1.0.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Local variables.

c---- Vector normalization factor.
      common /laptscmz/ sum
c---- Square of vw vector length.
      common /laptscmz/ sumsq
cbugc***DEBUG begins.
cbug      common /laptscmz/ sumsqs
cbug 9901 format (/ 'aptscmz scattering by au around u axis:' /
cbug     &  '  au=',1pe22.14)
cbug      write (3, 9901) au
cbugc***DEBUG ends.

c.... Test for input errors.

      nerr = 0

      if ((au .lt. -1.0) .or. (au .gt. 1.0)) then
        nerr = 1
        go to 210
      endif

c.... Sample randomly on a cone at angle arccos (au) from u axis.

  100 av    = 1.0 - 2.0 * ranf( )
      aw    = 1.0 - 2.0 * ranf( )
      sumsq = av**2 + aw**2
      if (sumsq .gt. 1.0) go to 100

      sum   = sqrt ((1.0 - au**2) / sumsq)
      av    = av * sum
      aw    = aw * sum
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptscmz results:' /
cbug     &  '  au,av,aw=',1p3e22.14 /
cbug     &  '  sumsq=   ',1pe22.14)
cbug      sumsqs = au**2 + av**2 + aw**2
cbug      write ( 3, 9902) au, av, aw, sumsqs
cbugc***DEBUG ends.

  210 return

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

UCRL-WEB-209832