2 SUBROUTINE RADBG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
3 C***BEGIN PROLOGUE RADBG
5 C***PURPOSE Calculate the fast Fourier transform of subvectors of
7 C***LIBRARY SLATEC (FFTPACK)
8 C***TYPE SINGLE PRECISION (RADBG-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 RADBG
27 DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
28 + C2(IDL1,*), CH2(IDL1,*), WA(*)
29 C***FIRST EXECUTABLE STATEMENT RADBG
38 IF (IDO .LT. L1) GO TO 103
54 CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
55 CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
58 IF (IDO .EQ. 1) GO TO 116
59 IF (NBD .LT. L1) GO TO 112
66 CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
67 CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
68 CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
69 CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
80 CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
81 CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
82 CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
83 CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
91 AR1H = DCP*AR1-DSP*AI1
95 C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
96 C2(IK,LC) = AI1*CH2(IK,IP)
104 AR2H = DC2*AR2-DS2*AI2
105 AI2 = DC2*AI2+DS2*AR2
108 C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
109 C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
115 CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
121 CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
122 CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
125 IF (IDO .EQ. 1) GO TO 132
126 IF (NBD .LT. L1) GO TO 128
132 CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
133 CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
134 CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
135 CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
144 CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
145 CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
146 CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
147 CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
152 IF (IDO .EQ. 1) RETURN
158 C1(1,K,J) = CH(1,K,J)
161 IF (NBD .GT. L1) GO TO 139
169 C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
170 C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
183 C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
184 C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)