external/fftpack/fftpack5/r4_tables.F

   1 subroutine r4_tables ( ido, ip, wa )
   2
   3 !*****************************************************************************80
   4 !
   5 !! R4_TABLES computes trigonometric 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 August 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   integer ( kind = 4 ) ido
  37   integer ( kind = 4 ) ip
  38
  39   real ( kind = 4 ) arg1
  40   real ( kind = 4 ) arg2
  41   real ( kind = 4 ) arg3
  42   real ( kind = 4 ) arg4
  43   real ( kind = 4 ) argz
  44   integer ( kind = 4 ) i
  45   integer ( kind = 4 ) j
  46   real ( kind = 4 ) tpi
  47   real ( kind = 4 ) wa(ido,ip-1,2)
  48
  49   tpi = 8.0E+00 * atan ( 1.0E+00 )
  50   argz = tpi / real ( ip, kind = 4 )
  51   arg1 = tpi / real ( ido * ip, kind = 4 )
  52
  53   do j = 2, ip
  54
  55     arg2 = real ( j - 1, kind = 4 ) * arg1
  56
  57     do i = 1, ido
  58       arg3 = real ( i - 1, kind = 4 ) * arg2
  59       wa(i,j-1,1) = cos ( arg3 )
  60       wa(i,j-1,2) = sin ( arg3 )
  61     end do
  62
  63     if ( 5 < ip ) then
  64       arg4 = real ( j - 1, kind = 4 ) * argz
  65       wa(1,j-1,1) = cos ( arg4 )
  66       wa(1,j-1,2) = sin ( arg4 )
  67     end if
  68
  69   end do
  70
  71   return
  72 end