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