updated top-level README and version_decl for V4.4.2 (#1795)
[WRF.git] / external / fftpack / fftpack5 / dfft1i.F
blob6a4df72675e27503c56defae02ef4a1056e5ae13
1 subroutine dfft1i ( n, wsave, lensav, ier )
3 !*****************************************************************************80
5 !! DFFT1I: initialization for DFFT1B and DFFT1F.
7 !  Discussion:
9 !    DFFT1I initializes array WSAVE for use in its companion routines
10 !    DFFT1B and DFFT1F.  The prime factorization of N together with a
11 !    tabulation of the trigonometric functions are computed and stored
12 !    in array WSAVE.  Separate WSAVE arrays are required for different
13 !    values of N.
17 !  Modified:
19 !    07 February 2006
21 !  Author:
23 !    Original real single precision by Paul Swarztrauber, Richard Valent.
24 !    Real double precision version by John Burkardt.
26 !  Reference:
28 !    Paul Swarztrauber,
29 !    Vectorizing the Fast Fourier Transforms,
30 !    in Parallel Computations,
31 !    edited by G. Rodrigue,
32 !    Academic Press, 1982.
34 !    Paul Swarztrauber,
35 !    Fast Fourier Transform Algorithms for Vector Computers,
36 !    Parallel Computing, pages 45-63, 1984.
38 !  Parameters:
40 !    Input, integer ( kind = 4 ) N, the length of the sequence to be
41 !    transformed.  The transform is most efficient when N is a product of
42 !    small primes.
44 !    Input, integer ( kind = 4 ) LENSAV, the dimension of the WSAVE array.
45 !    LENSAV must be at least N + INT(LOG(REAL(N))) + 4.
47 !    Output, real ( kind = 8 ) WSAVE(LENSAV), containing the prime factors
48 !    of N and also containing certain trigonometric values which will be used
49 !    in routines DFFT1B or DFFT1F.
51 !    Output, integer ( kind = 4 ) IER, error flag.
52 !    0, successful exit;
53 !    2, input parameter LENSAV not big enough.
55   implicit none
57   integer ( kind = 4 ) lensav
59   integer ( kind = 4 ) ier
60   integer ( kind = 4 ) n
61   real ( kind = 8 ) wsave(lensav)
63   ier = 0
65   if ( lensav < n + int ( log ( real ( n, kind = 8 ) ) ) + 4 ) then
66     ier = 2
67     call xerfft ( 'DFFT1I ', 3 )
68     return
69   end if
71   if ( n == 1 ) then
72     return
73   end if
75   call dffti1 ( n, wsave(1), wsave(n+1) )
77   return
78 end