external/fftpack/fftpack5/r8_mcfti1.F

   1 subroutine r8_mcfti1 ( n, wa, fnf, fac )
   2
   3 !*****************************************************************************80
   4 !
   5 !! R8_MCFTI1 sets up factors and tables, real double precision arithmetic.
   6 !
   7 !
   8 !
   9 !  Modified:
  10 !
  11 !    27 August 2009
  12 !
  13 !  Author:
  14 !
  15 !    Original real single precision version by Paul Swarztrauber, Dick Valent.
  16 !    Real double precision version by John Burkardt.
  17 !
  18 !  Reference:
  19 !
  20 !    Paul Swarztrauber,
  21 !    Vectorizing the Fast Fourier Transforms,
  22 !    in Parallel Computations,
  23 !    edited by G. Rodrigue,
  24 !    Academic Press, 1982.
  25 !
  26 !    Paul Swarztrauber,
  27 !    Fast Fourier Transform Algorithms for Vector Computers,
  28 !    Parallel Computing, pages 45-63, 1984.
  29 !
  30 !  Parameters:
  31 !
  32   implicit none
  33
  34   real ( kind = 8 ) fac(*)
  35   real ( kind = 8 ) fnf
  36   integer ( kind = 4 ) ido
  37   integer ( kind = 4 ) ip
  38   integer ( kind = 4 ) iw
  39   integer ( kind = 4 ) k1
  40   integer ( kind = 4 ) l1
  41   integer ( kind = 4 ) l2
  42   integer ( kind = 4 ) n
  43   integer ( kind = 4 ) nf
  44   real ( kind = 8 ) wa(*)
  45 !
  46 !  Get the factorization of N.
  47 !
  48   call r8_factor ( n, nf, fac )
  49   fnf = real ( nf, kind = 8 )
  50   iw = 1
  51   l1 = 1
  52 !
  53 !  Set up the trigonometric tables.
  54 !
  55   do k1 = 1, nf
  56     ip = int ( fac(k1) )
  57     l2 = l1 * ip
  58     ido = n / l2
  59     call r8_tables ( ido, ip, wa(iw) )
  60     iw = iw + ( ip - 1 ) * ( ido + ido )
  61     l1 = l2
  62   end do
  63
  64   return
  65 end