This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / rsa.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 RSA (MM, X, IX, Y, IY)
11 C     ANALYSIS OR SYNTHESIS OF A REAL ODD 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 = IX + 1
26       NFWA = NI + 1
27       NLWA = NI + N2 - 1
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 C
42       IF(NQ2M1) 50, 40, 20
43 C
44    20 DO 30 IT = 1, NQ2M1
45       NOR1 = NO1 + IT
46       NOR2 = NO1 + NQ2 + IT
47       NIR1 = NI1 + IT
48       NIR2 = NI2 - IT
49       W(NOR1) = W(NIR1) - W(NIR2)
50       W(NOR2) = W(NIR1) + W(NIR2)
51    30 CONTINUE
52 C
53    40 NOR1 = NO1 + NQ2
54       NIR1 = NI1 + NQ2
55       W(NOR1) = W(NIR1) + W(NIR1)
56 C
57    50 NO1 = NO1 + NQ
58       NO2 = NO2 - NQ
59       NI1 = NI2 + NQ
60       NI2 = NI1 + NQ
61       IF(NO1 - NO2) 60, 120, 160
62 C
63    60 NC = 0
64       NS = N4
65       KC = 0
66       KS = N4
67 C
68    70 CONTINUE
69       W(NO1) = + W(NI1) + W(NI2)
70       W(NO2) = - W(NI1) + W(NI2)
71 C
72       IF(NQ2M1) 110, 100, 80
73 C
74    80 NC = NC + NQ
75       NS = NS - NQ
76       CC = W(NC)
77       SS = W(NS)
78       DO 90 IT = 1, NQ2M1
79       NOI1 = NO1 + IT
80       NOI2 = NO2 + IT
81       NII1 = NI1 + IT
82       NII2 = NI2 - IT
83       NOR1 = NOI1 + NQ2
84       NOR2 = NOI2 + NQ2
85       NIR1 = NII1 + NQ
86       NIR2 = NII2 + NQ
87       RE = CC * W(NIR2) - SS * W(NII2)
88       AI = SS * W(NIR2) + CC * W(NII2)
89       W(NOR1) = W(NIR1) - RE
90       W(NOR2) = W(NIR1) + RE
91       W(NOI1) = + W(NII1) + AI
92       W(NOI2) = - W(NII1) + AI
93    90 CONTINUE
94 C
95   100 KC = KC + NQ2
96       KS = KS - NQ2
97       NOR1 = NO1 + NQ2
98       NOR2 = NO2 + NQ2
99       NIR1 = NI1 + NQ2
100       NIR2 = NI2 + NQ2
101       W(NOR1) = 2.0 * (+ W(KC) * W(NIR1) + W(KS) * W(NIR2))
102       W(NOR2) = 2.0 * (- W(KS) * W(NIR1) + W(KC) * W(NIR2))
103 C
104   110 NO1 = NO1 + NQ
105       NO2 = NO2 - NQ
106       NI1 = NI2 + NQ
107       NI2 = NI1 + NQ
108       IF(NO1 - NO2) 70, 120, 160
109 C
110   120 NIR1 = NI + NQ
111       W(NO1) = W(NIR1)
112 C
113       IF(NQ2M1) 160, 150, 130
114 C
115   130 DO 140 IT = 1, NQ2M1
116       NOI1 = NO1 + IT
117       NOR1 = NOI1 + NQ2
118       NIR1 = NI + NQ + IT
119       NIR2 = NI + NQ + NQ - IT
120       W(NOR1) = W(NIR1)
121       W(NOI1) = W(NIR2)
122   140 CONTINUE
123 C
124   150 NOR1 = NO1 + NQ2
125       NIR1 = NI + NQ + NQ2
126       W(NOR1) = RTTWO * W(NIR1)
127 C
128   160 NT = NI
129       NI = NO
130       NO = NT
131       NQ = NQ2
132   170 CONTINUE
133 C
134       Y(1) = X(1)
135       KY = IY + 1
136       NFWA = NI + 1
137       NLWA = NI + N2 - 1
138       DO 180 I = NFWA, NLWA
139       Y(KY) = W(I) * F
140   180 KY = KY + IY
141       Y(KY) = X(KX)
142 C
143       RETURN
144       END