Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / external / fftpack / fftpack5 / zfft2b.F
blob9accceb86abb348ebcc8e811b9dad2f4c249b256
1 subroutine zfft2b ( ldim, l, m, c, wsave, lensav, work, lenwrk, ier )
3 !*****************************************************************************80
5 !! ZFFT2B: complex double precision backward fast Fourier transform, 2D.
7 !  Discussion:
9 !    ZFFT2B computes the two-dimensional discrete Fourier transform of a
10 !    complex periodic array.  This transform is known as the backward
11 !    transform or Fourier synthesis, transforming from spectral to
12 !    physical space.  Routine ZFFT2B is normalized, in that a call to
13 !    ZFFT2B followed by a call to ZFFT2F (or vice-versa) reproduces the
14 !    original array within roundoff error.
16 !    On 10 May 2010, this code was modified by changing the value
17 !    of an index into the WSAVE array.
21 !  Modified:
23 !    10 May 2010
25 !  Author:
27 !    Original complex single precision by Paul Swarztrauber, Richard Valent.
28 !    Complex double precision version by John Burkardt.
30 !  Reference:
32 !    Paul Swarztrauber,
33 !    Vectorizing the Fast Fourier Transforms,
34 !    in Parallel Computations,
35 !    edited by G. Rodrigue,
36 !    Academic Press, 1982.
38 !    Paul Swarztrauber,
39 !    Fast Fourier Transform Algorithms for Vector Computers,
40 !    Parallel Computing, pages 45-63, 1984.
42 !  Parameters:
44 !    Input, integer ( kind = 4 ) LDIM, the first dimension of C.
46 !    Input, integer ( kind = 4 ) L, the number of elements to be transformed
47 !    in the first dimension of the two-dimensional complex array C.  The value
48 !    of L must be less than or equal to that of LDIM.  The transform is
49 !    most efficient when L is a product of small primes.
51 !    Input, integer ( kind = 4 ) M, the number of elements to be transformed
52 !    in the second dimension of the two-dimensional complex array C.  The
53 !    transform is most efficient when M is a product of small primes.
55 !    Input/output, complex ( kind = 8 ) C(LDIM,M), on intput, the array of two
56 !    dimensions containing the (L,M) subarray to be transformed.  On output,
57 !    the transformed data.
59 !    Input, real ( kind = 8 ) WSAVE(LENSAV). WSAVE's contents must be
60 !    initialized with a call to ZFFT2I before the first call to routine ZFFT2F
61 !    or ZFFT2B with transform lengths L and M.  WSAVE's contents may be
62 !    re-used for subsequent calls to ZFFT2F and ZFFT2B with the same
63 !    transform lengths L and M.
65 !    Input, integer ( kind = 4 ) LENSAV, the dimension of the WSAVE array.
66 !    LENSAV must be at least 2*(L+M) + INT(LOG(REAL(L)))
67 !    + INT(LOG(REAL(M))) + 8.
69 !    Workspace, real ( kind = 8 ) WORK(LENWRK).
71 !    Input, integer ( kind = 4 ) LENWRK, the dimension of the WORK array.
72 !    LENWRK must be at least 2*L*M.
74 !    Output, integer ( kind = 4 ) IER, the error flag.
75 !    0, successful exit;
76 !    2, input parameter LENSAV not big enough;
77 !    3, input parameter LENWRK not big enough;
78 !    5, input parameter LDIM < L;
79 !    20, input error returned by lower level routine.
81   implicit none
83   integer ( kind = 4 ) m
84   integer ( kind = 4 ) ldim
85   integer ( kind = 4 ) lensav
86   integer ( kind = 4 ) lenwrk
88   complex ( kind = 8 ) c(ldim,m)
89   integer ( kind = 4 ) ier
90   integer ( kind = 4 ) ier1
91   integer ( kind = 4 ) iw
92   integer ( kind = 4 ) l
93   real ( kind = 8 ) work(lenwrk)
94   real ( kind = 8 ) wsave(lensav)
96   ier = 0
98   if ( ldim < l ) then
99     ier = 5
100     call xerfft ( 'ZFFT2B', -2 )
101     return
102   end if
104   if ( lensav < 2 * l + int ( log ( real ( l, kind = 8 ) ) ) + &
105                 2 * m + int ( log ( real ( m, kind = 8 ) ) ) + 8 ) then
106     ier = 2
107     call xerfft ( 'ZFFT2B', 6 )
108     return
109   end if
111   if ( lenwrk < 2 * l * m ) then
112     ier = 3
113     call xerfft ( 'ZFFT2B', 8 )
114     return
115   end if
117 !  Transform the X lines of the C array.
119 !  On 10 May 2010, the value of IW was modified.
121   iw = 2 * l + int ( log ( real ( l, kind = 8 ) ) ) + 5
123   call zfftmb ( l, 1, m, ldim, c, (l-1)+ldim*(m-1) +1, &
124     wsave(iw), 2*m + int(log(real ( m, kind = 8 ))) + 4, work, 2*l*m, ier1 )
126   if ( ier1 /= 0 ) then
127     ier = 20
128     call xerfft ( 'ZFFT2B', -5 )
129     return
130   end if
132 !  Transform the Y lines of the C array.
134   iw = 1
135   call zfftmb ( m, ldim, l, 1, c, (m-1)*ldim + l, wsave(iw), &
136     2*l + int(log(real ( l, kind = 8 ))) + 4, work, 2*m*l, ier1 )
138   if ( ier1 /= 0 ) then
139     ier = 20
140     call xerfft ( 'ZFFT2B', -5 )
141     return
142   end if
144   return