1*DECK PASSF5
2      SUBROUTINE PASSF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
3C***BEGIN PROLOGUE  PASSF5
4C***SUBSIDIARY
5C***PURPOSE  Calculate the fast Fourier transform of subvectors of
6C            length five.
7C***LIBRARY   SLATEC (FFTPACK)
8C***TYPE      SINGLE PRECISION (PASSF5-S)
9C***AUTHOR  Swarztrauber, P. N., (NCAR)
10C***ROUTINES CALLED  (NONE)
11C***REVISION HISTORY  (YYMMDD)
12C   790601  DATE WRITTEN
13C   830401  Modified to use SLATEC library source file format.
14C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
15C           (a) changing dummy array size declarations (1) to (*),
16C           (b) changing definition of variables PI, TI11, TI12,
17C               TR11, TR12 by using FORTRAN intrinsic functions ATAN
18C               and SIN instead of DATA statements.
19C   881128  Modified by Dick Valent to meet prologue standards.
20C   890831  Modified array declarations.  (WRB)
21C   891214  Prologue converted to Version 4.0 format.  (BAB)
22C   900402  Added TYPE section.  (WRB)
23C***END PROLOGUE  PASSF5
24      DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*),
25     +          WA4(*)
26C***FIRST EXECUTABLE STATEMENT  PASSF5
27      PI = 4.*ATAN(1.)
28      TR11 = SIN(.1*PI)
29      TI11 = -SIN(.4*PI)
30      TR12 = -SIN(.3*PI)
31      TI12 = -SIN(.2*PI)
32      IF (IDO .NE. 2) GO TO 102
33      DO 101 K=1,L1
34         TI5 = CC(2,2,K)-CC(2,5,K)
35         TI2 = CC(2,2,K)+CC(2,5,K)
36         TI4 = CC(2,3,K)-CC(2,4,K)
37         TI3 = CC(2,3,K)+CC(2,4,K)
38         TR5 = CC(1,2,K)-CC(1,5,K)
39         TR2 = CC(1,2,K)+CC(1,5,K)
40         TR4 = CC(1,3,K)-CC(1,4,K)
41         TR3 = CC(1,3,K)+CC(1,4,K)
42         CH(1,K,1) = CC(1,1,K)+TR2+TR3
43         CH(2,K,1) = CC(2,1,K)+TI2+TI3
44         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
45         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
46         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
47         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
48         CR5 = TI11*TR5+TI12*TR4
49         CI5 = TI11*TI5+TI12*TI4
50         CR4 = TI12*TR5-TI11*TR4
51         CI4 = TI12*TI5-TI11*TI4
52         CH(1,K,2) = CR2-CI5
53         CH(1,K,5) = CR2+CI5
54         CH(2,K,2) = CI2+CR5
55         CH(2,K,3) = CI3+CR4
56         CH(1,K,3) = CR3-CI4
57         CH(1,K,4) = CR3+CI4
58         CH(2,K,4) = CI3-CR4
59         CH(2,K,5) = CI2-CR5
60  101 CONTINUE
61      RETURN
62  102 IF(IDO/2.LT.L1) GO TO 105
63      DO 104 K=1,L1
64CDIR$ IVDEP
65         DO 103 I=2,IDO,2
66            TI5 = CC(I,2,K)-CC(I,5,K)
67            TI2 = CC(I,2,K)+CC(I,5,K)
68            TI4 = CC(I,3,K)-CC(I,4,K)
69            TI3 = CC(I,3,K)+CC(I,4,K)
70            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
71            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
72            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
73            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
74            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
75            CH(I,K,1) = CC(I,1,K)+TI2+TI3
76            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
77            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
78            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
79            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
80            CR5 = TI11*TR5+TI12*TR4
81            CI5 = TI11*TI5+TI12*TI4
82            CR4 = TI12*TR5-TI11*TR4
83            CI4 = TI12*TI5-TI11*TI4
84            DR3 = CR3-CI4
85            DR4 = CR3+CI4
86            DI3 = CI3+CR4
87            DI4 = CI3-CR4
88            DR5 = CR2+CI5
89            DR2 = CR2-CI5
90            DI5 = CI2-CR5
91            DI2 = CI2+CR5
92            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
93            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
94            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
95            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
96            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4
97            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4
98            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5
99            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5
100  103    CONTINUE
101  104 CONTINUE
102      RETURN
103  105 DO 107 I=2,IDO,2
104CDIR$ IVDEP
105         DO 106 K=1,L1
106            TI5 = CC(I,2,K)-CC(I,5,K)
107            TI2 = CC(I,2,K)+CC(I,5,K)
108            TI4 = CC(I,3,K)-CC(I,4,K)
109            TI3 = CC(I,3,K)+CC(I,4,K)
110            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
111            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
112            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
113            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
114            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
115            CH(I,K,1) = CC(I,1,K)+TI2+TI3
116            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
117            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
118            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
119            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
120            CR5 = TI11*TR5+TI12*TR4
121            CI5 = TI11*TI5+TI12*TI4
122            CR4 = TI12*TR5-TI11*TR4
123            CI4 = TI12*TI5-TI11*TI4
124            DR3 = CR3-CI4
125            DR4 = CR3+CI4
126            DI3 = CI3+CR4
127            DI4 = CI3-CR4
128            DR5 = CR2+CI5
129            DR2 = CR2-CI5
130            DI5 = CI2-CR5
131            DI2 = CI2+CR5
132            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
133            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
134            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
135            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
136            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4
137            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4
138            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5
139            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5
140  106    CONTINUE
141  107 CONTINUE
142      RETURN
143      END
144