1*DECK CFFTF1
2      SUBROUTINE CFFTF1 (N, C, CH, WA, IFAC)
3C***BEGIN PROLOGUE  CFFTF1
4C***PURPOSE  Compute the forward transform of a complex, periodic
5C            sequence.
6C***LIBRARY   SLATEC (FFTPACK)
7C***CATEGORY  J1A2
8C***TYPE      COMPLEX (RFFTF1-S, CFFTF1-C)
9C***KEYWORDS  FFTPACK, FOURIER TRANSFORM
10C***AUTHOR  Swarztrauber, P. N., (NCAR)
11C***DESCRIPTION
12C
13C  Subroutine CFFTF1 computes the forward complex discrete Fourier
14C  transform (the Fourier analysis).  Equivalently, CFFTF1 computes
15C  the Fourier coefficients of a complex periodic sequence.
16C  The transform is defined below at output parameter C.
17C
18C  The transform is not normalized.  To obtain a normalized transform
19C  the output must be divided by N.  Otherwise a call of CFFTF1
20C  followed by a call of CFFTB1 will multiply the sequence by N.
21C
22C  The arrays WA and IFAC which are used by subroutine CFFTB1 must be
23C  initialized by calling subroutine CFFTI1 (N, WA, IFAC).
24C
25C  Input Parameters
26C
27C  N       the length of the complex sequence C.  The method is
28C          more efficient when N is the product of small primes.
29C
30C  C       a complex array of length N which contains the sequence
31C
32C  CH      a real work array of length at least 2*N
33C
34C  WA      a real work array which must be dimensioned at least 2*N.
35C
36C  IFAC    an integer work array which must be dimensioned at least 15.
37C
38C          The WA and IFAC arrays must be initialized by calling
39C          subroutine CFFTI1 (N, WA, IFAC), and different WA and IFAC
40C          arrays must be used for each different value of N.  This
41C          initialization does not have to be repeated so long as N
42C          remains unchanged.  Thus subsequent transforms can be
43C          obtained faster than the first.  The same WA and IFAC arrays
44C          can be used by CFFTF1 and CFFTB1.
45C
46C  Output Parameters
47C
48C  C       For J=1,...,N
49C
50C              C(J)=the sum from K=1,...,N of
51C
52C                 C(K)*EXP(-I*(J-1)*(K-1)*2*PI/N)
53C
54C                         where I=SQRT(-1)
55C
56C  NOTE:   WA and IFAC contain initialization calculations which must
57C          not be destroyed between calls of subroutine CFFTF1 or CFFTB1
58C
59C***REFERENCES  P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
60C                 Computations (G. Rodrigue, ed.), Academic Press,
61C                 1982, pp. 51-83.
62C***ROUTINES CALLED  PASSF, PASSF2, PASSF3, PASSF4, PASSF5
63C***REVISION HISTORY  (YYMMDD)
64C   790601  DATE WRITTEN
65C   830401  Modified to use SLATEC library source file format.
66C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
67C           changing dummy array size declarations (1) to (*).
68C   881128  Modified by Dick Valent to meet prologue standards.
69C   891214  Prologue converted to Version 4.0 format.  (BAB)
70C   900131  Routine changed from subsidiary to user-callable.  (WRB)
71C   920501  Reformatted the REFERENCES section.  (WRB)
72C***END PROLOGUE  CFFTF1
73      DIMENSION CH(*), C(*), WA(*), IFAC(*)
74C***FIRST EXECUTABLE STATEMENT  CFFTF1
75      NF = IFAC(2)
76      NA = 0
77      L1 = 1
78      IW = 1
79      DO 116 K1=1,NF
80         IP = IFAC(K1+2)
81         L2 = IP*L1
82         IDO = N/L2
83         IDOT = IDO+IDO
84         IDL1 = IDOT*L1
85         IF (IP .NE. 4) GO TO 103
86         IX2 = IW+IDOT
87         IX3 = IX2+IDOT
88         IF (NA .NE. 0) GO TO 101
89         CALL PASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
90         GO TO 102
91  101    CALL PASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
92  102    NA = 1-NA
93         GO TO 115
94  103    IF (IP .NE. 2) GO TO 106
95         IF (NA .NE. 0) GO TO 104
96         CALL PASSF2 (IDOT,L1,C,CH,WA(IW))
97         GO TO 105
98  104    CALL PASSF2 (IDOT,L1,CH,C,WA(IW))
99  105    NA = 1-NA
100         GO TO 115
101  106    IF (IP .NE. 3) GO TO 109
102         IX2 = IW+IDOT
103         IF (NA .NE. 0) GO TO 107
104         CALL PASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
105         GO TO 108
106  107    CALL PASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
107  108    NA = 1-NA
108         GO TO 115
109  109    IF (IP .NE. 5) GO TO 112
110         IX2 = IW+IDOT
111         IX3 = IX2+IDOT
112         IX4 = IX3+IDOT
113         IF (NA .NE. 0) GO TO 110
114         CALL PASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
115         GO TO 111
116  110    CALL PASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
117  111    NA = 1-NA
118         GO TO 115
119  112    IF (NA .NE. 0) GO TO 113
120         CALL PASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
121         GO TO 114
122  113    CALL PASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
123  114    IF (NAC .NE. 0) NA = 1-NA
124  115    L1 = L2
125         IW = IW+(IP-1)*IDOT
126  116 CONTINUE
127      IF (NA .EQ. 0) RETURN
128      N2 = N+N
129      DO 117 I=1,N2
130         C(I) = CH(I)
131  117 CONTINUE
132      RETURN
133      END
134