1 SUBROUTINE VRADFG (MP,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,MDIMC,WA) 2C 3C VRFFTPK, VERSION 1, AUGUST 1985 4C 5 DIMENSION CH(MDIMC,IDO,L1,IP) ,CC(MDIMC,IDO,IP,L1) , 6 1 C1(MDIMC,IDO,L1,IP) ,C2(MDIMC,IDL1,IP), 7 2 CH2(MDIMC,IDL1,IP) ,WA(IDO) 8 TPI=2.*PIMACH(1.0) 9 ARG = TPI/FLOAT(IP) 10 DCP = COS(ARG) 11 DSP = SIN(ARG) 12 IPPH = (IP+1)/2 13 IPP2 = IP+2 14 IDP2 = IDO+2 15 NBD = (IDO-1)/2 16 IF (IDO .EQ. 1) GO TO 119 17 DO 101 IK=1,IDL1 18 DO 1001 M=1,MP 19 CH2(M,IK,1) = C2(M,IK,1) 20 1001 CONTINUE 21 101 CONTINUE 22 DO 103 J=2,IP 23 DO 102 K=1,L1 24 DO 1002 M=1,MP 25 CH(M,1,K,J) = C1(M,1,K,J) 26 1002 CONTINUE 27 102 CONTINUE 28 103 CONTINUE 29 IF (NBD .GT. L1) GO TO 107 30 IS = -IDO 31 DO 106 J=2,IP 32 IS = IS+IDO 33 IDIJ = IS 34 DO 105 I=3,IDO,2 35 IDIJ = IDIJ+2 36 DO 104 K=1,L1 37 DO 1004 M=1,MP 38 CH(M,I-1,K,J) = WA(IDIJ-1)*C1(M,I-1,K,J)+WA(IDIJ) 39 1 *C1(M,I,K,J) 40 CH(M,I,K,J) = WA(IDIJ-1)*C1(M,I,K,J)-WA(IDIJ) 41 1 *C1(M,I-1,K,J) 42 1004 CONTINUE 43 104 CONTINUE 44 105 CONTINUE 45 106 CONTINUE 46 GO TO 111 47 107 IS = -IDO 48 DO 110 J=2,IP 49 IS = IS+IDO 50 DO 109 K=1,L1 51 IDIJ = IS 52 DO 108 I=3,IDO,2 53 IDIJ = IDIJ+2 54 DO 1008 M=1,MP 55 CH(M,I-1,K,J) = WA(IDIJ-1)*C1(M,I-1,K,J)+WA(IDIJ) 56 1 *C1(M,I,K,J) 57 CH(M,I,K,J) = WA(IDIJ-1)*C1(M,I,K,J)-WA(IDIJ) 58 1 *C1(M,I-1,K,J) 59 1008 CONTINUE 60 108 CONTINUE 61 109 CONTINUE 62 110 CONTINUE 63 111 IF (NBD .LT. L1) GO TO 115 64 DO 114 J=2,IPPH 65 JC = IPP2-J 66 DO 113 K=1,L1 67 DO 112 I=3,IDO,2 68 DO 1012 M=1,MP 69 C1(M,I-1,K,J) = CH(M,I-1,K,J)+CH(M,I-1,K,JC) 70 C1(M,I-1,K,JC) = CH(M,I,K,J)-CH(M,I,K,JC) 71 C1(M,I,K,J) = CH(M,I,K,J)+CH(M,I,K,JC) 72 C1(M,I,K,JC) = CH(M,I-1,K,JC)-CH(M,I-1,K,J) 73 1012 CONTINUE 74 112 CONTINUE 75 113 CONTINUE 76 114 CONTINUE 77 GO TO 121 78 115 DO 118 J=2,IPPH 79 JC = IPP2-J 80 DO 117 I=3,IDO,2 81 DO 116 K=1,L1 82 DO 1016 M=1,MP 83 C1(M,I-1,K,J) = CH(M,I-1,K,J)+CH(M,I-1,K,JC) 84 C1(M,I-1,K,JC) = CH(M,I,K,J)-CH(M,I,K,JC) 85 C1(M,I,K,J) = CH(M,I,K,J)+CH(M,I,K,JC) 86 C1(M,I,K,JC) = CH(M,I-1,K,JC)-CH(M,I-1,K,J) 87 1016 CONTINUE 88 116 CONTINUE 89 117 CONTINUE 90 118 CONTINUE 91 GO TO 121 92 119 DO 120 IK=1,IDL1 93 DO 1020 M=1,MP 94 C2(M,IK,1) = CH2(M,IK,1) 95 1020 CONTINUE 96 120 CONTINUE 97 121 DO 123 J=2,IPPH 98 JC = IPP2-J 99 DO 122 K=1,L1 100 DO 1022 M=1,MP 101 C1(M,1,K,J) = CH(M,1,K,J)+CH(M,1,K,JC) 102 C1(M,1,K,JC) = CH(M,1,K,JC)-CH(M,1,K,J) 103 1022 CONTINUE 104 122 CONTINUE 105 123 CONTINUE 106C 107 AR1 = 1. 108 AI1 = 0. 109 DO 127 L=2,IPPH 110 LC = IPP2-L 111 AR1H = DCP*AR1-DSP*AI1 112 AI1 = DCP*AI1+DSP*AR1 113 AR1 = AR1H 114 DO 124 IK=1,IDL1 115 DO 1024 M=1,MP 116 CH2(M,IK,L) = C2(M,IK,1)+AR1*C2(M,IK,2) 117 CH2(M,IK,LC) = AI1*C2(M,IK,IP) 118 1024 CONTINUE 119 124 CONTINUE 120 DC2 = AR1 121 DS2 = AI1 122 AR2 = AR1 123 AI2 = AI1 124 DO 126 J=3,IPPH 125 JC = IPP2-J 126 AR2H = DC2*AR2-DS2*AI2 127 AI2 = DC2*AI2+DS2*AR2 128 AR2 = AR2H 129 DO 125 IK=1,IDL1 130 DO 1025 M=1,MP 131 CH2(M,IK,L) = CH2(M,IK,L)+AR2*C2(M,IK,J) 132 CH2(M,IK,LC) = CH2(M,IK,LC)+AI2*C2(M,IK,JC) 133 1025 CONTINUE 134 125 CONTINUE 135 126 CONTINUE 136 127 CONTINUE 137 DO 129 J=2,IPPH 138 DO 128 IK=1,IDL1 139 DO 1028 M=1,MP 140 CH2(M,IK,1) = CH2(M,IK,1)+C2(M,IK,J) 141 1028 CONTINUE 142 128 CONTINUE 143 129 CONTINUE 144C 145 IF (IDO .LT. L1) GO TO 132 146 DO 131 K=1,L1 147 DO 130 I=1,IDO 148 DO 1030 M=1,MP 149 CC(M,I,1,K) = CH(M,I,K,1) 150 1030 CONTINUE 151 130 CONTINUE 152 131 CONTINUE 153 GO TO 135 154 132 DO 134 I=1,IDO 155 DO 133 K=1,L1 156 DO 1033 M=1,MP 157 CC(M,I,1,K) = CH(M,I,K,1) 158 1033 CONTINUE 159 133 CONTINUE 160 134 CONTINUE 161 135 DO 137 J=2,IPPH 162 JC = IPP2-J 163 J2 = J+J 164 DO 136 K=1,L1 165 DO 1036 M=1,MP 166 CC(M,IDO,J2-2,K) = CH(M,1,K,J) 167 CC(M,1,J2-1,K) = CH(M,1,K,JC) 168 1036 CONTINUE 169 136 CONTINUE 170 137 CONTINUE 171 IF (IDO .EQ. 1) RETURN 172 IF (NBD .LT. L1) GO TO 141 173 DO 140 J=2,IPPH 174 JC = IPP2-J 175 J2 = J+J 176 DO 139 K=1,L1 177 DO 138 I=3,IDO,2 178 IC = IDP2-I 179 DO 1038 M=1,MP 180 CC(M,I-1,J2-1,K) = CH(M,I-1,K,J)+CH(M,I-1,K,JC) 181 CC(M,IC-1,J2-2,K) = CH(M,I-1,K,J)-CH(M,I-1,K,JC) 182 CC(M,I,J2-1,K) = CH(M,I,K,J)+CH(M,I,K,JC) 183 CC(M,IC,J2-2,K) = CH(M,I,K,JC)-CH(M,I,K,J) 184 1038 CONTINUE 185 138 CONTINUE 186 139 CONTINUE 187 140 CONTINUE 188 RETURN 189 141 DO 144 J=2,IPPH 190 JC = IPP2-J 191 J2 = J+J 192 DO 143 I=3,IDO,2 193 IC = IDP2-I 194 DO 142 K=1,L1 195 DO 1042 M=1,MP 196 CC(M,I-1,J2-1,K) = CH(M,I-1,K,J)+CH(M,I-1,K,JC) 197 CC(M,IC-1,J2-2,K) = CH(M,I-1,K,J)-CH(M,I-1,K,JC) 198 CC(M,I,J2-1,K) = CH(M,I,K,J)+CH(M,I,K,JC) 199 CC(M,IC,J2-2,K) = CH(M,I,K,JC)-CH(M,I,K,J) 200 1042 CONTINUE 201 142 CONTINUE 202 143 CONTINUE 203 144 CONTINUE 204 RETURN 205 END 206