updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / external / fftpack / fftpack5 / z1f2kf.F
blobaa3b273a544770b20a7fcc8fcef129e817cdd05f
1 subroutine z1f2kf ( ido, l1, na, cc, in1, ch, in2, wa )
3 !*****************************************************************************80
5 !! Z1F2KF is an FFTPACK5 auxiliary routine.
9 !  Modified:
11 !    26 Ausust 2009
13 !  Author:
15 !    Original complex single precision by Paul Swarztrauber, Richard Valent.
16 !    Complex double precision version by John Burkardt.
18 !  Reference:
20 !    Paul Swarztrauber,
21 !    Vectorizing the Fast Fourier Transforms,
22 !    in Parallel Computations,
23 !    edited by G. Rodrigue,
24 !    Academic Press, 1982.
26 !    Paul Swarztrauber,
27 !    Fast Fourier Transform Algorithms for Vector Computers,
28 !    Parallel Computing, pages 45-63, 1984.
30 !  Parameters:
32   implicit none
34   integer ( kind = 4 ) ido
35   integer ( kind = 4 ) in1
36   integer ( kind = 4 ) in2
37   integer ( kind = 4 ) l1
39   real ( kind = 8 ) cc(in1,l1,ido,2)
40   real ( kind = 8 ) ch(in2,l1,2,ido)
41   real ( kind = 8 ) chold1
42   real ( kind = 8 ) chold2
43   integer ( kind = 4 ) i
44   integer ( kind = 4 ) k
45   integer ( kind = 4 ) na
46   real ( kind = 8 ) sn
47   real ( kind = 8 ) ti2
48   real ( kind = 8 ) tr2
49   real ( kind = 8 ) wa(ido,1,2)
51   if ( 1 < ido ) then
53     do k = 1, l1
54       ch(1,k,1,1) = cc(1,k,1,1) + cc(1,k,1,2)
55       ch(1,k,2,1) = cc(1,k,1,1) - cc(1,k,1,2)
56       ch(2,k,1,1) = cc(2,k,1,1) + cc(2,k,1,2)
57       ch(2,k,2,1) = cc(2,k,1,1) - cc(2,k,1,2)
58     end do
60     do i = 2, ido
61       do k = 1, l1
62         ch(1,k,1,i) = cc(1,k,i,1) + cc(1,k,i,2)
63         tr2         = cc(1,k,i,1) - cc(1,k,i,2)
64         ch(2,k,1,i) = cc(2,k,i,1) + cc(2,k,i,2)
65         ti2         = cc(2,k,i,1) - cc(2,k,i,2)
66         ch(2,k,2,i) = wa(i,1,1) * ti2 - wa(i,1,2) * tr2
67         ch(1,k,2,i) = wa(i,1,1) * tr2 + wa(i,1,2) * ti2
68       end do
69     end do
71   else if ( na == 1 ) then
73     sn = 1.0D+00 / real ( 2 * l1, kind = 8 )
75     do k = 1, l1
76       ch(1,k,1,1) = sn * ( cc(1,k,1,1) + cc(1,k,1,2) )
77       ch(1,k,2,1) = sn * ( cc(1,k,1,1) - cc(1,k,1,2) )
78       ch(2,k,1,1) = sn * ( cc(2,k,1,1) + cc(2,k,1,2) )
79       ch(2,k,2,1) = sn * ( cc(2,k,1,1) - cc(2,k,1,2) )
80     end do
82   else
84     sn = 1.0D+00 / real ( 2 * l1, kind = 8 )
86     do k = 1, l1
88       chold1      = sn * ( cc(1,k,1,1) + cc(1,k,1,2) )
89       cc(1,k,1,2) = sn * ( cc(1,k,1,1) - cc(1,k,1,2) )
90       cc(1,k,1,1) = chold1
92       chold2      = sn * ( cc(2,k,1,1) + cc(2,k,1,2) )
93       cc(2,k,1,2) = sn * ( cc(2,k,1,1) - cc(2,k,1,2) )
94       cc(2,k,1,1) = chold2
96     end do
98   end if
100   return