Line data    Source code

       1             :       MODULE m_sphpts
       2             :       CONTAINS
       3          24 :       SUBROUTINE sphpts(p,n,r,pos)
       4             : c     *******************************************************
       5             : c     generates points on sphere at pos with radius r
       6             : c     e. wimmer     feb. 1980
       7             : c     modified to give a better distribution of points
       8             : c     m. weinert    jan. 1982
       9             : c     *******************************************************
      10             :       USE m_qranf
      11             :       USE m_constants, ONLY : tpi_const
      12             :       IMPLICIT NONE
      13             : C     .. Scalar Arguments ..
      14             :       REAL r
      15             :       INTEGER n
      16             : C     ..
      17             : C     .. Array Arguments ..
      18             :       REAL p(3,n),pos(3)
      19             : C     ..
      20             : C     .. Local Scalars ..
      21             :       REAL phi,t,tc,x,xr,y,yr,z
      22             :       INTEGER i,j
      23             : C     ..
      24             : C     .. Intrinsic Functions ..
      25             :       INTRINSIC cos,sin,sqrt
      26             : C     ..
      27          24 :       j = 0
      28          24 :       xr = sqrt(13.e0)
      29          24 :       yr = sqrt(7.e0)
      30        8424 :       DO  i = 1,n
      31        8400 :          tc = 2.e0*qranf(xr,j) - 1.e0
      32        8400 :          phi = tpi_const*qranf(yr,j)
      33        8400 :          t = sqrt(1.e0-tc*tc)
      34        8400 :          x = t*cos(phi)
      35        8400 :          y = t*sin(phi)
      36        8400 :          z = tc
      37        8400 :          p(1,i) = r*x + pos(1)
      38        8400 :          p(2,i) = r*y + pos(2)
      39        8424 :          p(3,i) = r*z + pos(3)
      40             :       ENDDO   
      41          24 :       RETURN
      42             :       END SUBROUTINE
      43             :       END