1*DECK RADF4
2      SUBROUTINE RADF4 (IDO, L1, CC, CH, WA1, WA2, WA3)
3C***BEGIN PROLOGUE  RADF4
4C***SUBSIDIARY
5C***PURPOSE  Calculate the fast Fourier transform of subvectors of
6C            length four.
7C***LIBRARY   SLATEC (FFTPACK)
8C***TYPE      SINGLE PRECISION (RADF4-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 variable HSQT2 by using
17C               FORTRAN intrinsic function SQRT instead of a DATA
18C               statement.
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  RADF4
24      DIMENSION CC(IDO,L1,4), CH(IDO,4,*), WA1(*), WA2(*), WA3(*)
25C***FIRST EXECUTABLE STATEMENT  RADF4
26      HSQT2 = .5*SQRT(2.)
27      DO 101 K=1,L1
28         TR1 = CC(1,K,2)+CC(1,K,4)
29         TR2 = CC(1,K,1)+CC(1,K,3)
30         CH(1,1,K) = TR1+TR2
31         CH(IDO,4,K) = TR2-TR1
32         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
33         CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
34  101 CONTINUE
35      IF (IDO-2) 107,105,102
36  102 IDP2 = IDO+2
37      IF((IDO-1)/2.LT.L1) GO TO 111
38      DO 104 K=1,L1
39CDIR$ IVDEP
40         DO 103 I=3,IDO,2
41            IC = IDP2-I
42            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
43            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
44            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
45            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
46            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
47            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
48            TR1 = CR2+CR4
49            TR4 = CR4-CR2
50            TI1 = CI2+CI4
51            TI4 = CI2-CI4
52            TI2 = CC(I,K,1)+CI3
53            TI3 = CC(I,K,1)-CI3
54            TR2 = CC(I-1,K,1)+CR3
55            TR3 = CC(I-1,K,1)-CR3
56            CH(I-1,1,K) = TR1+TR2
57            CH(IC-1,4,K) = TR2-TR1
58            CH(I,1,K) = TI1+TI2
59            CH(IC,4,K) = TI1-TI2
60            CH(I-1,3,K) = TI4+TR3
61            CH(IC-1,2,K) = TR3-TI4
62            CH(I,3,K) = TR4+TI3
63            CH(IC,2,K) = TR4-TI3
64  103    CONTINUE
65  104 CONTINUE
66      GO TO 110
67  111 DO 109 I=3,IDO,2
68         IC = IDP2-I
69CDIR$ IVDEP
70         DO 108 K=1,L1
71            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
72            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
73            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
74            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
75            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
76            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
77            TR1 = CR2+CR4
78            TR4 = CR4-CR2
79            TI1 = CI2+CI4
80            TI4 = CI2-CI4
81            TI2 = CC(I,K,1)+CI3
82            TI3 = CC(I,K,1)-CI3
83            TR2 = CC(I-1,K,1)+CR3
84            TR3 = CC(I-1,K,1)-CR3
85            CH(I-1,1,K) = TR1+TR2
86            CH(IC-1,4,K) = TR2-TR1
87            CH(I,1,K) = TI1+TI2
88            CH(IC,4,K) = TI1-TI2
89            CH(I-1,3,K) = TI4+TR3
90            CH(IC-1,2,K) = TR3-TI4
91            CH(I,3,K) = TR4+TI3
92            CH(IC,2,K) = TR4-TI3
93  108    CONTINUE
94  109 CONTINUE
95  110 IF (MOD(IDO,2) .EQ. 1) RETURN
96  105 DO 106 K=1,L1
97         TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
98         TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
99         CH(IDO,1,K) = TR1+CC(IDO,K,1)
100         CH(IDO,3,K) = CC(IDO,K,1)-TR1
101         CH(1,2,K) = TI1-CC(IDO,K,3)
102         CH(1,4,K) = TI1+CC(IDO,K,3)
103  106 CONTINUE
104  107 RETURN
105      END
106