1 SUBROUTINE RADFG(IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA) 2C***BEGIN PROLOGUE RADFG 3C***REFER TO RFFTF 4C***ROUTINES CALLED (NONE) 5C***REVISION HISTORY (YYMMDD) 6C 000330 Modified array declarations. (JEC) 7C 8C***END PROLOGUE RADFG 9 DIMENSION CH(IDO,L1,IP) ,CC(IDO,IP,L1) , 10 1 C1(IDO,L1,IP) ,C2(IDL1,IP), 11 2 CH2(IDL1,IP) ,WA(*) 12 DATA TPI/6.28318530717959/ 13C***FIRST EXECUTABLE STATEMENT RADFG 14 ARG = TPI/FLOAT(IP) 15 DCP = COS(ARG) 16 DSP = SIN(ARG) 17 IPPH = (IP+1)/2 18 IPP2 = IP+2 19 IDP2 = IDO+2 20 NBD = (IDO-1)/2 21 IF (IDO .EQ. 1) GO TO 119 22 DO 101 IK=1,IDL1 23 CH2(IK,1) = C2(IK,1) 24 101 CONTINUE 25 DO 103 J=2,IP 26 DO 102 K=1,L1 27 CH(1,K,J) = C1(1,K,J) 28 102 CONTINUE 29 103 CONTINUE 30 IF (NBD .GT. L1) GO TO 107 31 IS = -IDO 32 DO 106 J=2,IP 33 IS = IS+IDO 34 IDIJ = IS 35 DO 105 I=3,IDO,2 36 IDIJ = IDIJ+2 37 DO 104 K=1,L1 38 CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J) 39 CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J) 40 104 CONTINUE 41 105 CONTINUE 42 106 CONTINUE 43 GO TO 111 44 107 IS = -IDO 45 DO 110 J=2,IP 46 IS = IS+IDO 47 DO 109 K=1,L1 48 IDIJ = IS 49CDIR$ IVDEP 50 DO 108 I=3,IDO,2 51 IDIJ = IDIJ+2 52 CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J) 53 CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J) 54 108 CONTINUE 55 109 CONTINUE 56 110 CONTINUE 57 111 IF (NBD .LT. L1) GO TO 115 58 DO 114 J=2,IPPH 59 JC = IPP2-J 60 DO 113 K=1,L1 61CDIR$ IVDEP 62 DO 112 I=3,IDO,2 63 C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC) 64 C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC) 65 C1(I,K,J) = CH(I,K,J)+CH(I,K,JC) 66 C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J) 67 112 CONTINUE 68 113 CONTINUE 69 114 CONTINUE 70 GO TO 121 71 115 DO 118 J=2,IPPH 72 JC = IPP2-J 73 DO 117 I=3,IDO,2 74 DO 116 K=1,L1 75 C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC) 76 C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC) 77 C1(I,K,J) = CH(I,K,J)+CH(I,K,JC) 78 C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J) 79 116 CONTINUE 80 117 CONTINUE 81 118 CONTINUE 82 GO TO 121 83 119 DO 120 IK=1,IDL1 84 C2(IK,1) = CH2(IK,1) 85 120 CONTINUE 86 121 DO 123 J=2,IPPH 87 JC = IPP2-J 88 DO 122 K=1,L1 89 C1(1,K,J) = CH(1,K,J)+CH(1,K,JC) 90 C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J) 91 122 CONTINUE 92 123 CONTINUE 93C 94 AR1 = 1. 95 AI1 = 0. 96 DO 127 L=2,IPPH 97 LC = IPP2-L 98 AR1H = DCP*AR1-DSP*AI1 99 AI1 = DCP*AI1+DSP*AR1 100 AR1 = AR1H 101 DO 124 IK=1,IDL1 102 CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2) 103 CH2(IK,LC) = AI1*C2(IK,IP) 104 124 CONTINUE 105 DC2 = AR1 106 DS2 = AI1 107 AR2 = AR1 108 AI2 = AI1 109 DO 126 J=3,IPPH 110 JC = IPP2-J 111 AR2H = DC2*AR2-DS2*AI2 112 AI2 = DC2*AI2+DS2*AR2 113 AR2 = AR2H 114 DO 125 IK=1,IDL1 115 CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J) 116 CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC) 117 125 CONTINUE 118 126 CONTINUE 119 127 CONTINUE 120 DO 129 J=2,IPPH 121 DO 128 IK=1,IDL1 122 CH2(IK,1) = CH2(IK,1)+C2(IK,J) 123 128 CONTINUE 124 129 CONTINUE 125C 126 IF (IDO .LT. L1) GO TO 132 127 DO 131 K=1,L1 128 DO 130 I=1,IDO 129 CC(I,1,K) = CH(I,K,1) 130 130 CONTINUE 131 131 CONTINUE 132 GO TO 135 133 132 DO 134 I=1,IDO 134 DO 133 K=1,L1 135 CC(I,1,K) = CH(I,K,1) 136 133 CONTINUE 137 134 CONTINUE 138 135 DO 137 J=2,IPPH 139 JC = IPP2-J 140 J2 = J+J 141 DO 136 K=1,L1 142 CC(IDO,J2-2,K) = CH(1,K,J) 143 CC(1,J2-1,K) = CH(1,K,JC) 144 136 CONTINUE 145 137 CONTINUE 146 IF (IDO .EQ. 1) RETURN 147 IF (NBD .LT. L1) GO TO 141 148 DO 140 J=2,IPPH 149 JC = IPP2-J 150 J2 = J+J 151 DO 139 K=1,L1 152CDIR$ IVDEP 153 DO 138 I=3,IDO,2 154 IC = IDP2-I 155 CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC) 156 CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC) 157 CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC) 158 CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J) 159 138 CONTINUE 160 139 CONTINUE 161 140 CONTINUE 162 RETURN 163 141 DO 144 J=2,IPPH 164 JC = IPP2-J 165 J2 = J+J 166 DO 143 I=3,IDO,2 167 IC = IDP2-I 168 DO 142 K=1,L1 169 CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC) 170 CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC) 171 CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC) 172 CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J) 173 142 CONTINUE 174 143 CONTINUE 175 144 CONTINUE 176 RETURN 177 END 178