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