C      ALGORITHM 441, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN COMMUNICATIONS OF THE ACM
C      VOL. 16, NO. 1, January, 1973, P.51.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Fortran/
#	Fortran/Sp/
#	Fortran/Sp/Drivers/
#	Fortran/Sp/Drivers/Makefile
#	Fortran/Sp/Drivers/driver.f
#	Fortran/Sp/Drivers/res
#	Fortran/Sp/Src/
#	Fortran/Sp/Src/src.f
# This archive created: Thu Dec 15 13:28:06 2005
export PATH; PATH=/bin:$PATH
if test ! -d 'Fortran'
then
	mkdir 'Fortran'
fi
cd 'Fortran'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test -f 'Makefile'
then
	echo shar: will not over-write existing file "'Makefile'"
else
cat << "SHAR_EOF" > 'Makefile'
all: Res

src.o: src.f
	$(F77) $(F77OPTS) -c src.f

driver.o: driver.f
	$(F77) $(F77OPTS) -c driver.f

DRIVERS= driver
RESULTS= Res

Objs1= driver.o src.o
driver: $(Objs1)
	$(F77) $(F77OPTS) -o driver $(Objs1) $(SRCLIBS)
Res: driver 
	./driver >Res

diffres:Res res
	echo "Differences in results from driver"
	$(DIFF) Res res

clean: 
	rm -rf *.o $(DRIVERS) $(CLEANUP) $(RESULTS)
SHAR_EOF
fi # end of overwriting check
if test -f 'driver.f'
then
	echo shar: will not over-write existing file "'driver.f'"
else
cat << "SHAR_EOF" > 'driver.f'
      program main

c***********************************************************************
c
cc TOMS441_PRB tests DIPOLE.
c
      implicit none

      integer sample_num
      integer test_num

      parameter ( sample_num = 1000 )
      parameter ( test_num = 3 )

      real a
      real alpha_test(test_num)
      real alpha
      real b
      real dipole
      integer i
      real mean
      real r
      real r_test(test_num)
      integer seed
      integer test
      real variance
      real x(sample_num)
      real xmax
      real xmin

      save alpha_test
      save r_test

      data alpha_test / 0.0, 0.785398163397448, 1.57079632679490 /
      data r_test / 1.0, 0.5, 0.0 /

      seed = 123456789

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS441_PRB'
      write ( *, '(a)' ) '  Test TOMS algorithm 441, generating'
      write ( *, '(a)' ) '  random deviates from the dipole '
      write ( *, '(a)' ) '  distribution.'

      do test = 1, test_num

        alpha = alpha_test(test)
        r = r_test(test)

        a = r * cos ( alpha )
        b = r * sin ( alpha )

        write ( *, '(a)' ) ' '
        write ( *, '(a,g14.6)' ) ' A = ', a
        write ( *, '(a,g14.6)' ) ' B = ', b

        xmax = -1.0E+30
        xmin = +1.0D+30
        mean = 0.0D+00

        do i = 1, sample_num
          x(i) = dipole ( a, b, seed )
          xmax = max ( xmax, x(i) )
          xmin = min ( xmin, x(i) )
          mean = mean + x(i)
        end do

        mean = mean / real ( sample_num )

        variance = 0.0
        do i = 1, sample_num
          variance = variance + ( x(i) - mean )**2
        end do
        variance = variance / real ( sample_num - 1 )

        write ( *, '(a)' ) ' '
        write ( *, '(a,i6)'    ) '  Sample size =     ', sample_num
        write ( *, '(a,g14.6)' ) '  Sample mean =     ', mean
        write ( *, '(a,g14.6)' ) '  Sample variance = ', variance
        write ( *, '(a,g14.6)' ) '  Sample maximum =  ', xmax
        write ( *, '(a,g14.6)' ) '  Sample minimum =  ', xmin

      end do

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TOMS441_PRB'
      write ( *, '(a)' ) '  Normal end of execution.'

      stop
      end
      function r11 ( seed )

c*******************************************************************************
c
cc R11 returns a pseudorandom number between -1 and +1.
c
c  Modified:
c
c    06 December 2005
c
c  Author:
c
c    John Burkardt
c
c  Parameters:
c
c    Input/output, integer SEED, the "seed" value, which should NOT be 0.
c    On output, SEED has been updated.
c
c    Output, real RD11, a new pseudorandom variate, strictly between -1 and 1.
c
      implicit none

      integer k
      real r11
      integer seed

      k = seed / 127773

      seed = 16807 * ( seed - k * 127773 ) - k * 2836

      if ( seed < 0 ) then
        seed = seed + 2147483647
      end if
c
c  Although SEED can be represented exactly as a 32 bit integer,
c  it generally cannot be represented exactly as a 32 bit real number!
c
      r11 = 2.0 * real ( dble ( seed ) * 4.656612875D-10 ) - 1.0

      return
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'res'
then
	echo shar: will not over-write existing file "'res'"
else
cat << "SHAR_EOF" > 'res'
 
TOMS441_PRB
  Test TOMS algorithm 441, generating
  random deviates from the dipole 
  distribution.
 
 A =    1.00000    
 B =    0.00000    
 
  Sample size =       1000
  Sample mean =       0.365594E-02
  Sample variance =   0.996543    
  Sample maximum =     7.78188    
  Sample minimum =    -8.35221    
 
 A =   0.353553    
 B =   0.353553    
 
  Sample size =       1000
  Sample mean =       0.110592    
  Sample variance =    298.053    
  Sample maximum =     257.363    
  Sample minimum =    -291.002    
 
 A =   -0.00000    
 B =    0.00000    
 
  Sample size =       1000
  Sample mean =        1.61698    
  Sample variance =    1352.47    
  Sample maximum =     759.231    
  Sample minimum =    -347.037    
 
TOMS441_PRB
  Normal end of execution.
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << "SHAR_EOF" > 'src.f'
      REAL FUNCTION DIPOLE ( A, B, SEED )
      EXTERNAL R11
      REAL X, Y, A, B, R11
      INTEGER SEED
10    X = R11 ( SEED )
      Y = R11 ( SEED )
      IF ( 1.0 - X * X - Y * Y ) 10, 10, 20
20    DIPOLE = ( Y + B ) / ( X + A )
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
cd ..
#       End of shell archive
exit 0