This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / fftrc.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:23  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE FFTRC(C,D,IX,F,G,IZ)
11 C
12 C         D701  FFTRC  FAST FOURIER TRANSFORM, REAL OR COMPLEX
13 C         B. FORNBERG  NOVEMBER 1973
14 C
15       COMPLEX A(16),T
16       DIMENSION E(32),C(1),D(1),F(1),G(1),S(2),NC(7)
17       COMMON /TAB/U(126),V(127)
18       EQUIVALENCE (A(1),E(1)),(S(1),T),(S(1),S1),(S(2),S2),(U(31),C3),(U
19      *(63),C7),(U(32),C9)
20       DATA NC/17,9,25,5,21,13,29/
21 C
22 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
23       ENTRY I16
24 #endif
25 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
26       ENTRY I16(C,D,IX,F,G,IZ)
27 #endif
28       IS = IX
29       I = 1
30       GOTO 40
31 C
32 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
33       ENTRY D16
34 #endif
35 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
36       ENTRY D16(C,D,IX,F,G,IZ)
37 #endif
38       IS = -IX
39       I = 1+16*IX
40    40 J = 1+8*IX
41       CALL D701BD
42       E(3) = C(1)-C(J)
43       E(1) = C(1)+C(J)
44       E(4) = D(1)-D(J)
45       E(2) = D(1)+D(J)
46       DO 10 L=1,7
47       I = I+IS
48       J = J+IS
49       N = NC(L)
50       E(N+2) = C(I)-C(J)
51       E(N) = C(I)+C(J)
52       E(N+3) = D(I)-D(J)
53    10 E(N+1) = D(I)+D(J)
54       DO 20 L=1,13,4
55       T = A(L+2)
56       A(L+2) = A(L)-T
57    20 A(L) = A(L)+T
58       DO 30 L=2,14,4
59       S1 = E(2*L+4)
60       S2 = -E(2*L+3)
61       A(L+2) = A(L)-T
62    30 A(L) = A(L)+T
63       T = A(5)
64       A(5) = A(1)-T
65       A(1) = A(1)+T
66       T = A(13)
67       A(13) = A(9)-T
68       A(9) = A(9)+T
69       S2 = -C7*(E(11)-E(12))
70       S1 = C7*(E(11)+E(12))
71       A(6) = A(2)-T
72       A(2) = A(2)+T
73       S2 = -C7*(E(27)-E(28))
74       S1 = C7*(E(27)+E(28))
75       A(14) = A(10)-T
76       A(10) = A(10)+T
77       S1 = E(14)
78       S2 = -E(13)
79       A(7) = A(3)-T
80       A(3) = A(3)+T
81       S1 = E(30)
82       S2 = -E(29)
83       A(15) = A(11)-T
84       A(11) = A(11)+T
85       S2 = -C7*(E(15)+E(16))
86       S1 = -C7*(E(15)-E(16))
87       A(8) = A(4)-T
88       A(4) = A(4)+T
89       S1 = -C7*(E(31)-E(32))
90       S2 = -C7*(E(31)+E(32))
91       A(16) = A(12)-T
92       A(12) = A(12)+T
93       I = 1
94       J = 1+8*IZ
95       F(J) = E(1)-E(17)
96       G(J) = E(2)-E(18)
97       F(I) = E(1)+E(17)
98       G(I) = E(2)+E(18)
99       I = I+IZ
100       J = J+IZ
101       S1 = C9*E(19)+C3*E(20)
102       S2 = C9*E(20)-C3*E(19)
103       F(J) = E( 3)-S1
104       G(J) = E( 4)-S2
105       F(I) = E( 3)+S1
106       G(I) = E( 4)+S2
107       I = I+IZ
108       J = J+IZ
109       S1 = C7*(E(21)+E(22))
110       S2 = -C7*(E(21)-E(22))
111       F(J) = E( 5)-S1
112       G(J) = E( 6)-S2
113       F(I) = E( 5)+S1
114       G(I) = E( 6)+S2
115       I = I+IZ
116       J = J+IZ
117       S1 = C3*E(23)+C9*E(24)
118       S2 = C3*E(24)-C9*E(23)
119       F(J) = E( 7)-S1
120       G(J) = E( 8)-S2
121       F(I) = E( 7)+S1
122       G(I) = E( 8)+S2
123       I = I+IZ
124       J = J+IZ
125       F(J) = E(9)-E(26)
126       G(J) = E(10)+E(25)
127       F(I) = E(9)+E(26)
128       G(I) = E(10)-E(25)
129       I = I+IZ
130       J = J+IZ
131       S1 = -C3*E(27)+C9*E(28)
132       S2 = -C3*E(28)-C9*E(27)
133       F(J) = E(11)-S1
134       G(J) = E(12)-S2
135       F(I) = E(11)+S1
136       G(I) = E(12)+S2
137       I = I+IZ
138       J = J+IZ
139       S1 = -C7*(E(29)-E(30))
140       S2 = -C7*(E(29)+E(30))
141       F(J) = E(13)-S1
142       G(J) = E(14)-S2
143       F(I) = E(13)+S1
144       G(I) = E(14)+S2
145       I = I+IZ
146       J = J+IZ
147       S1 = -C9*E(31)+C3*E(32)
148       S2 = -C9*E(32)-C3*E(31)
149       F(J) = E(15)-S1
150       G(J) = E(16)-S2
151       F(I) = E(15)+S1
152       G(I) = E(16)+S2
153       RETURN
154       END