2 SUBROUTINE RADFG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
3 C***BEGIN PROLOGUE RADFG
5 C***PURPOSE Calculate the fast Fourier transform of subvectors of
7 C***LIBRARY SLATEC (FFTPACK)
8 C***TYPE SINGLE PRECISION (RADFG-S)
9 C***AUTHOR Swarztrauber, P. N., (NCAR)
10 C***ROUTINES CALLED (NONE)
11 C***REVISION HISTORY (YYMMDD)
13 C 830401 Modified to use SLATEC library source file format.
14 C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
15 C (a) changing dummy array size declarations (1) to (*),
16 C (b) changing references to intrinsic function FLOAT
18 C (c) changing definition of variable TPI by using
19 C FORTRAN intrinsic function ATAN instead of a DATA
21 C 881128 Modified by Dick Valent to meet prologue standards.
22 C 890531 Changed all specific intrinsics to generic. (WRB)
23 C 890831 Modified array declarations. (WRB)
24 C 891214 Prologue converted to Version 4.0 format. (BAB)
25 C 900402 Added TYPE section. (WRB)
26 C***END PROLOGUE RADFG
27 DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
28 + C2(IDL1,*), CH2(IDL1,*), WA(*)
29 C***FIRST EXECUTABLE STATEMENT RADFG
38 IF (IDO .EQ. 1) GO TO 119
47 IF (NBD .GT. L1) GO TO 107
55 CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
56 CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
69 CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
70 CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
74 111 IF (NBD .LT. L1) GO TO 115
80 C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
81 C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
82 C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
83 C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
92 C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
93 C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
94 C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
95 C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
106 C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
107 C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
115 AR1H = DCP*AR1-DSP*AI1
116 AI1 = DCP*AI1+DSP*AR1
119 CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
120 CH2(IK,LC) = AI1*C2(IK,IP)
128 AR2H = DC2*AR2-DS2*AI2
129 AI2 = DC2*AI2+DS2*AR2
132 CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
133 CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
139 CH2(IK,1) = CH2(IK,1)+C2(IK,J)
143 IF (IDO .LT. L1) GO TO 132
146 CC(I,1,K) = CH(I,K,1)
152 CC(I,1,K) = CH(I,K,1)
159 CC(IDO,J2-2,K) = CH(1,K,J)
160 CC(1,J2-1,K) = CH(1,K,JC)
163 IF (IDO .EQ. 1) RETURN
164 IF (NBD .LT. L1) GO TO 141
172 CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
173 CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
174 CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
175 CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
186 CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
187 CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
188 CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
189 CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)