This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / rca.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:22  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE RCA (MM, X, IX, Y, IY)
11 C     ANALYSIS OR SYNTHESIS OF A REAL EVEN FUNCTION.
12 C
13       REAL X(128), Y(128)
14       COMMON /D700DT/ N, N2, N4, M, F, RTTWO
15       COMMON /FWORK/ W(321)
16       DATA MLOC / - 1 /
17 C
18       M = MM + 1
19       IF(M .NE. MLOC) CALL D700SU
20       MLOC = M
21 C
22       NI = N4
23       NO = N4 + N2 + 1
24 C
25       KX = 1
26       NFWA = NI
27       NLWA = NI + N2
28       DO 10 I = NFWA, NLWA
29       W(I) = X(KX)
30    10 KX = KX + IX
31 C
32       NQ = N2
33       DO 170 L = 1, M
34       NQ2 = NQ / 2
35       NQ2M1 = NQ2 - 1
36 C
37       NO1 = NO
38       NO2 = NO + N2
39       NI1 = NI
40       NI2 = NI + NQ
41       W(NO1) = W(NI1) + W(NI2)
42       W(NO2) = W(NI1) - W(NI2)
43 C
44       IF(NQ2M1) 50, 40, 20
45 C
46    20 DO 30 IT = 1, NQ2M1
47       NOR1 = NO1 + IT
48       NOR2 = NO1 + NQ2 + IT
49       NIR1 = NI1 + IT
50       NIR2 = NI2 - IT
51       W(NOR1) = W(NIR1) + W(NIR2)
52       W(NOR2) = W(NIR1) - W(NIR2)
53    30 CONTINUE
54 C
55    40 NOR1 = NO1 + NQ2
56       NIR1 = NI1 + NQ2
57       W(NOR1) = W(NIR1) + W(NIR1)
58 C
59    50 NO1 = NO1 + NQ
60       NO2 = NO2 - NQ
61       NI1 = NI2 + NQ
62       NI2 = NI1 + NQ
63       IF(NO1 - NO2) 60, 120, 160
64 C
65    60 NC = 0
66       NS = N4
67       KC = 0
68       KS = N4
69 C
70    70 CONTINUE
71       W(NO1) = W(NI1) + W(NI2)
72       W(NO2) = W(NI1) - W(NI2)
73 C
74       IF(NQ2M1) 110, 100, 80
75 C
76    80 NC = NC + NQ
77       NS = NS - NQ
78       CC = W(NC)
79       SS = W(NS)
80       DO 90 IT = 1, NQ2M1
81       NOR1 = NO1 + IT
82       NOR2 = NO2 + IT
83       NIR1 = NI1 + IT
84       NIR2 = NI2 - IT
85       NOI1 = NOR1 + NQ2
86       NOI2 = NOR2 + NQ2
87       NII1 = NIR1 + NQ
88       NII2 = NIR2 + NQ
89       RE = CC * W(NIR2) - SS * W(NII2)
90       AI = SS * W(NIR2) + CC * W(NII2)
91       W(NOR1) = W(NIR1) + RE
92       W(NOR2) = W(NIR1) - RE
93       W(NOI1) = + W(NII1) - AI
94       W(NOI2) = - W(NII1) - AI
95    90 CONTINUE
96 C
97   100 KC = KC + NQ2
98       KS = KS - NQ2
99       NOR1 = NO1 + NQ2
100       NOR2 = NO2 + NQ2
101       NIR1 = NI1 + NQ2
102       NIR2 = NI2 + NQ2
103       W(NOR1) = 2.0 * (W(KC) * W(NIR1) - W(KS) * W(NIR2))
104       W(NOR2) = 2.0 * (W(KS) * W(NIR1) + W(KC) * W(NIR2))
105 C
106   110 NO1 = NO1 + NQ
107       NO2 = NO2 - NQ
108       NI1 = NI2 + NQ
109       NI2 = NI1 + NQ
110       IF(NO1 - NO2) 70, 120, 160
111 C
112   120 W(NO1) = W(NI1)
113 C
114       IF(NQ2M1) 160, 150, 130
115 C
116   130 DO 140 IT = 1, NQ2M1
117       NOR1 = NO1 + IT
118       NOI1 = NOR1 + NQ2
119       NIR1 = NI + NQ + IT
120       NIR2 = NI + NQ + NQ - IT
121       W(NOR1) = + W(NIR1)
122       W(NOI1) = - W(NIR2)
123   140 CONTINUE
124 C
125   150 NOR1 = NO1 + NQ2
126       NIR1 = NI + NQ + NQ2
127       W(NOR1) = RTTWO * W(NIR1)
128 C
129   160 NT = NI
130       NI = NO
131       NO = NT
132       NQ = NQ2
133   170 CONTINUE
134 C
135       KY = 1
136       NFWA = NI
137       NLWA = NI + N2
138       DO 180 I = NFWA, NLWA
139       Y(KY) = W(I) * F
140   180 KY = KY + IY
141 C
142       RETURN
143       END