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