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