updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / external / fftpack / fftpack5 / c1fm1b.F
blob63af11d35f4c9da274c8919bdb8d11764de74776
1 subroutine c1fm1b ( n, inc, c, ch, wa, fnf, fac )
3 !*****************************************************************************80
5 !! C1FM1B is an FFTPACK5 auxiliary routine.
8 !    Copyright (C) 1995-2004, Scientific Computing Division,
9 !    University Corporation for Atmospheric Research
11 !  Modified:
13 !    27 March 2009
15 !  Author:
17 !    Paul Swarztrauber
18 !    Richard Valent
20 !  Reference:
22 !    Paul Swarztrauber,
23 !    Vectorizing the Fast Fourier Transforms,
24 !    in Parallel Computations,
25 !    edited by G. Rodrigue,
26 !    Academic Press, 1982.
28 !    Paul Swarztrauber,
29 !    Fast Fourier Transform Algorithms for Vector Computers,
30 !    Parallel Computing, pages 45-63, 1984.
32 !  Parameters:
34   implicit none
36   complex ( kind = 4 ) c(*)
37   real ( kind = 4 ) ch(*)
38   real ( kind = 4 ) fac(*)
39   real ( kind = 4 ) fnf
40   integer ( kind = 4 ) ido
41   integer ( kind = 4 ) inc
42   integer ( kind = 4 ) inc2
43   integer ( kind = 4 ) ip
44   integer ( kind = 4 ) iw
45   integer ( kind = 4 ) k
46   integer ( kind = 4 ) k1
47   integer ( kind = 4 ) l1
48   integer ( kind = 4 ) l2
49   integer ( kind = 4 ) lid
50   integer ( kind = 4 ) n
51   integer ( kind = 4 ) na
52   integer ( kind = 4 ) nbr
53   integer ( kind = 4 ) nf
54   real ( kind = 4 ) wa(*)
56   inc2 = inc + inc
57   nf = int ( fnf )
58   na = 0
59   l1 = 1
60   iw = 1
62   do k1 = 1, nf
64     ip = int ( fac(k1) )
65     l2 = ip * l1
66     ido = n / l2
67     lid = l1 * ido
68     nbr = 1 + na + 2 * min ( ip - 2, 4 )
70     if ( nbr == 1 ) then
71       call c1f2kb ( ido, l1, na, c, inc2, ch, 2, wa(iw) )
72     else if ( nbr == 2 ) then
73       call c1f2kb ( ido, l1, na, ch, 2, c, inc2, wa(iw) )
74     else if ( nbr == 3 ) then
75       call c1f3kb ( ido, l1, na, c, inc2, ch, 2, wa(iw) )
76     else if ( nbr == 4 ) then
77       call c1f3kb ( ido, l1, na, ch, 2, c, inc2, wa(iw) )
78     else if ( nbr == 5 ) then
79       call c1f4kb ( ido, l1, na, c, inc2, ch, 2, wa(iw) )
80     else if ( nbr == 6 ) then
81       call c1f4kb ( ido, l1, na, ch, 2, c, inc2, wa(iw) )
82     else if ( nbr == 7 ) then
83       call c1f5kb ( ido, l1, na, c, inc2, ch, 2, wa(iw) )
84     else if ( nbr == 8 ) then
85       call c1f5kb ( ido, l1, na, ch, 2, c, inc2, wa(iw) )
86     else if ( nbr == 9 ) then
87       call c1fgkb ( ido, ip, l1, lid, na, c, c, inc2, ch, ch, 2, wa(iw) )
88     else if ( nbr == 10 ) then
89       call c1fgkb ( ido, ip, l1, lid, na, ch, ch, 2, c, c, inc2, wa(iw) )
90     end if
92     l1 = l2
93     iw = iw + ( ip - 1 ) * ( ido + ido )
95     if ( ip <= 5 ) then
96       na = 1 - na
97     end if
99   end do
101   return