1*DECK PASSF4
2      SUBROUTINE PASSF4 (IDO, L1, CC, CH, WA1, WA2, WA3)
3C***BEGIN PROLOGUE  PASSF4
4C***SUBSIDIARY
5C***PURPOSE  Calculate the fast Fourier transform of subvectors of
6C            length four.
7C***LIBRARY   SLATEC (FFTPACK)
8C***TYPE      SINGLE PRECISION (PASSF4-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           changing dummy array size declarations (1) to (*).
16C   881128  Modified by Dick Valent to meet prologue standards.
17C   890831  Modified array declarations.  (WRB)
18C   891214  Prologue converted to Version 4.0 format.  (BAB)
19C   900402  Added TYPE section.  (WRB)
20C***END PROLOGUE  PASSF4
21      DIMENSION CC(IDO,4,*), CH(IDO,L1,4), WA1(*), WA2(*), WA3(*)
22C***FIRST EXECUTABLE STATEMENT  PASSF4
23      IF (IDO .NE. 2) GO TO 102
24      DO 101 K=1,L1
25         TI1 = CC(2,1,K)-CC(2,3,K)
26         TI2 = CC(2,1,K)+CC(2,3,K)
27         TR4 = CC(2,2,K)-CC(2,4,K)
28         TI3 = CC(2,2,K)+CC(2,4,K)
29         TR1 = CC(1,1,K)-CC(1,3,K)
30         TR2 = CC(1,1,K)+CC(1,3,K)
31         TI4 = CC(1,4,K)-CC(1,2,K)
32         TR3 = CC(1,2,K)+CC(1,4,K)
33         CH(1,K,1) = TR2+TR3
34         CH(1,K,3) = TR2-TR3
35         CH(2,K,1) = TI2+TI3
36         CH(2,K,3) = TI2-TI3
37         CH(1,K,2) = TR1+TR4
38         CH(1,K,4) = TR1-TR4
39         CH(2,K,2) = TI1+TI4
40         CH(2,K,4) = TI1-TI4
41  101 CONTINUE
42      RETURN
43  102 IF(IDO/2.LT.L1) GO TO 105
44      DO 104 K=1,L1
45CDIR$ IVDEP
46         DO 103 I=2,IDO,2
47            TI1 = CC(I,1,K)-CC(I,3,K)
48            TI2 = CC(I,1,K)+CC(I,3,K)
49            TI3 = CC(I,2,K)+CC(I,4,K)
50            TR4 = CC(I,2,K)-CC(I,4,K)
51            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
52            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
53            TI4 = CC(I-1,4,K)-CC(I-1,2,K)
54            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
55            CH(I-1,K,1) = TR2+TR3
56            CR3 = TR2-TR3
57            CH(I,K,1) = TI2+TI3
58            CI3 = TI2-TI3
59            CR2 = TR1+TR4
60            CR4 = TR1-TR4
61            CI2 = TI1+TI4
62            CI4 = TI1-TI4
63            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2
64            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2
65            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3
66            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3
67            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4
68            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4
69  103    CONTINUE
70  104 CONTINUE
71      RETURN
72  105 DO 107 I=2,IDO,2
73CDIR$ IVDEP
74         DO 106 K=1,L1
75            TI1 = CC(I,1,K)-CC(I,3,K)
76            TI2 = CC(I,1,K)+CC(I,3,K)
77            TI3 = CC(I,2,K)+CC(I,4,K)
78            TR4 = CC(I,2,K)-CC(I,4,K)
79            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
80            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
81            TI4 = CC(I-1,4,K)-CC(I-1,2,K)
82            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
83            CH(I-1,K,1) = TR2+TR3
84            CR3 = TR2-TR3
85            CH(I,K,1) = TI2+TI3
86            CI3 = TI2-TI3
87            CR2 = TR1+TR4
88            CR4 = TR1-TR4
89            CI2 = TI1+TI4
90            CI4 = TI1-TI4
91            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2
92            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2
93            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3
94            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3
95            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4
96            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4
97  106    CONTINUE
98  107 CONTINUE
99      RETURN
100      END
101