1*DECK RADBG 2 SUBROUTINE RADBG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA) 3C***BEGIN PROLOGUE RADBG 4C***SUBSIDIARY 5C***PURPOSE Calculate the fast Fourier transform of subvectors of 6C arbitrary length. 7C***LIBRARY SLATEC (FFTPACK) 8C***TYPE SINGLE PRECISION (RADBG-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 references to intrinsic function FLOAT 17C to REAL, and 18C (c) changing definition of variable TPI by using 19C FORTRAN intrinsic function ATAN instead of a DATA 20C statement. 21C 881128 Modified by Dick Valent to meet prologue standards. 22C 890531 Changed all specific intrinsics to generic. (WRB) 23C 890831 Modified array declarations. (WRB) 24C 891214 Prologue converted to Version 4.0 format. (BAB) 25C 900402 Added TYPE section. (WRB) 26C***END PROLOGUE RADBG 27 DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*), 28 + C2(IDL1,*), CH2(IDL1,*), WA(*) 29C***FIRST EXECUTABLE STATEMENT RADBG 30 TPI = 8.*ATAN(1.) 31 ARG = TPI/IP 32 DCP = COS(ARG) 33 DSP = SIN(ARG) 34 IDP2 = IDO+2 35 NBD = (IDO-1)/2 36 IPP2 = IP+2 37 IPPH = (IP+1)/2 38 IF (IDO .LT. L1) GO TO 103 39 DO 102 K=1,L1 40 DO 101 I=1,IDO 41 CH(I,K,1) = CC(I,1,K) 42 101 CONTINUE 43 102 CONTINUE 44 GO TO 106 45 103 DO 105 I=1,IDO 46 DO 104 K=1,L1 47 CH(I,K,1) = CC(I,1,K) 48 104 CONTINUE 49 105 CONTINUE 50 106 DO 108 J=2,IPPH 51 JC = IPP2-J 52 J2 = J+J 53 DO 107 K=1,L1 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) 56 107 CONTINUE 57 108 CONTINUE 58 IF (IDO .EQ. 1) GO TO 116 59 IF (NBD .LT. L1) GO TO 112 60 DO 111 J=2,IPPH 61 JC = IPP2-J 62 DO 110 K=1,L1 63CDIR$ IVDEP 64 DO 109 I=3,IDO,2 65 IC = IDP2-I 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) 70 109 CONTINUE 71 110 CONTINUE 72 111 CONTINUE 73 GO TO 116 74 112 DO 115 J=2,IPPH 75 JC = IPP2-J 76CDIR$ IVDEP 77 DO 114 I=3,IDO,2 78 IC = IDP2-I 79 DO 113 K=1,L1 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) 84 113 CONTINUE 85 114 CONTINUE 86 115 CONTINUE 87 116 AR1 = 1. 88 AI1 = 0. 89 DO 120 L=2,IPPH 90 LC = IPP2-L 91 AR1H = DCP*AR1-DSP*AI1 92 AI1 = DCP*AI1+DSP*AR1 93 AR1 = AR1H 94 DO 117 IK=1,IDL1 95 C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2) 96 C2(IK,LC) = AI1*CH2(IK,IP) 97 117 CONTINUE 98 DC2 = AR1 99 DS2 = AI1 100 AR2 = AR1 101 AI2 = AI1 102 DO 119 J=3,IPPH 103 JC = IPP2-J 104 AR2H = DC2*AR2-DS2*AI2 105 AI2 = DC2*AI2+DS2*AR2 106 AR2 = AR2H 107 DO 118 IK=1,IDL1 108 C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J) 109 C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC) 110 118 CONTINUE 111 119 CONTINUE 112 120 CONTINUE 113 DO 122 J=2,IPPH 114 DO 121 IK=1,IDL1 115 CH2(IK,1) = CH2(IK,1)+CH2(IK,J) 116 121 CONTINUE 117 122 CONTINUE 118 DO 124 J=2,IPPH 119 JC = IPP2-J 120 DO 123 K=1,L1 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) 123 123 CONTINUE 124 124 CONTINUE 125 IF (IDO .EQ. 1) GO TO 132 126 IF (NBD .LT. L1) GO TO 128 127 DO 127 J=2,IPPH 128 JC = IPP2-J 129 DO 126 K=1,L1 130CDIR$ IVDEP 131 DO 125 I=3,IDO,2 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) 136 125 CONTINUE 137 126 CONTINUE 138 127 CONTINUE 139 GO TO 132 140 128 DO 131 J=2,IPPH 141 JC = IPP2-J 142 DO 130 I=3,IDO,2 143 DO 129 K=1,L1 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) 148 129 CONTINUE 149 130 CONTINUE 150 131 CONTINUE 151 132 CONTINUE 152 IF (IDO .EQ. 1) RETURN 153 DO 133 IK=1,IDL1 154 C2(IK,1) = CH2(IK,1) 155 133 CONTINUE 156 DO 135 J=2,IP 157 DO 134 K=1,L1 158 C1(1,K,J) = CH(1,K,J) 159 134 CONTINUE 160 135 CONTINUE 161 IF (NBD .GT. L1) GO TO 139 162 IS = -IDO 163 DO 138 J=2,IP 164 IS = IS+IDO 165 IDIJ = IS 166 DO 137 I=3,IDO,2 167 IDIJ = IDIJ+2 168 DO 136 K=1,L1 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) 171 136 CONTINUE 172 137 CONTINUE 173 138 CONTINUE 174 GO TO 143 175 139 IS = -IDO 176 DO 142 J=2,IP 177 IS = IS+IDO 178 DO 141 K=1,L1 179 IDIJ = IS 180CDIR$ IVDEP 181 DO 140 I=3,IDO,2 182 IDIJ = IDIJ+2 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) 185 140 CONTINUE 186 141 CONTINUE 187 142 CONTINUE 188 143 RETURN 189 END 190