Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / external / fftpack / fftpack5 / zfft1i.F
blob15ef73c3a0c71263ad57bdf1700b904b6ae5b264
1 subroutine zfft1i ( n, wsave, lensav, ier )
3 !*****************************************************************************80
5 !! ZFFT1I: initialization for ZFFT1B and ZFFT1F.
7 !  Discussion:
9 !    ZFFT1I initializes array WSAVE for use in its companion routines
10 !    ZFFT1B and ZFFT1F.  Routine ZFFT1I must be called before the first
11 !    call to ZFFT1B or ZFFT1F, and after whenever the value of integer
12 !    N changes.
16 !  Modified:
18 !    26 Ausust 2009
20 !  Author:
22 !    Original complex single precision by Paul Swarztrauber, Richard Valent.
23 !    Complex double precision version by John Burkardt.
25 !  Reference:
27 !    Paul Swarztrauber,
28 !    Vectorizing the Fast Fourier Transforms,
29 !    in Parallel Computations,
30 !    edited by G. Rodrigue,
31 !    Academic Press, 1982.
33 !    Paul Swarztrauber,
34 !    Fast Fourier Transform Algorithms for Vector Computers,
35 !    Parallel Computing, pages 45-63, 1984.
37 !  Parameters:
39 !    Input, integer ( kind = 4 ) N, the length of the sequence to be
40 !    transformed.  The transform is most efficient when N is a product
41 !    of small primes.
43 !    Input, integer ( kind = 4 ) LENSAV, the dimension of the WSAVE array.
44 !    LENSAV must be at least 2*N + INT(LOG(REAL(N))) + 4.
46 !    Output, real ( kind = 8 ) WSAVE(LENSAV), containing the prime factors
47 !    of N and  also containing certain trigonometric values which will be used
48 !    in routines ZFFT1B or ZFFT1F.
50 !    Output, integer ( kind = 4 ) IER, error flag.
51 !    0, successful exit;
52 !    2, input parameter LENSAV not big enough.
54   implicit none
56   integer ( kind = 4 ) lensav
58   integer ( kind = 4 ) ier
59   integer ( kind = 4 ) iw1
60   integer ( kind = 4 ) n
61   real ( kind = 8 ) wsave(lensav)
63   ier = 0
65   if ( lensav < 2 * n + int ( log ( real ( n, kind = 8 ) ) ) + 4 ) then
66     ier = 2
67     call xerfft ( 'ZFFT1I', 3 )
68     return
69   end if
71   if ( n == 1 ) then
72     return
73   end if
75   iw1 = n + n + 1
77   call r8_mcfti1 ( n, wsave, wsave(iw1), wsave(iw1+1) )
79   return
80 end