external/fftpack/fftpack5/r4_mcfti1.F

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