annotate gcc/ada/libgnat/a-ngcoar.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- ADA.NUMERICS.GENERIC_COMPLEX_ARRAYS --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 2006-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 with System.Generic_Array_Operations; use System.Generic_Array_Operations;
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 package body Ada.Numerics.Generic_Complex_Arrays is
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 -- Operations that are defined in terms of operations on the type Real,
kono
parents:
diff changeset
37 -- such as addition, subtraction and scaling, are computed in the canonical
kono
parents:
diff changeset
38 -- way looping over all elements.
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 package Ops renames System.Generic_Array_Operations;
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 subtype Real is Real_Arrays.Real;
kono
parents:
diff changeset
43 -- Work around visibility bug ???
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 function Is_Non_Zero (X : Complex) return Boolean is (X /= (0.0, 0.0));
kono
parents:
diff changeset
46 -- Needed by Back_Substitute
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 procedure Back_Substitute is new Ops.Back_Substitute
kono
parents:
diff changeset
49 (Scalar => Complex,
kono
parents:
diff changeset
50 Matrix => Complex_Matrix,
kono
parents:
diff changeset
51 Is_Non_Zero => Is_Non_Zero);
kono
parents:
diff changeset
52
kono
parents:
diff changeset
53 procedure Forward_Eliminate is new Ops.Forward_Eliminate
kono
parents:
diff changeset
54 (Scalar => Complex,
kono
parents:
diff changeset
55 Real => Real'Base,
kono
parents:
diff changeset
56 Matrix => Complex_Matrix,
kono
parents:
diff changeset
57 Zero => (0.0, 0.0),
kono
parents:
diff changeset
58 One => (1.0, 0.0));
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 procedure Transpose is new Ops.Transpose
kono
parents:
diff changeset
61 (Scalar => Complex,
kono
parents:
diff changeset
62 Matrix => Complex_Matrix);
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64 -- Helper function that raises a Constraint_Error is the argument is
kono
parents:
diff changeset
65 -- not a square matrix, and otherwise returns its length.
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 function Length is new Square_Matrix_Length (Complex, Complex_Matrix);
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 -- Instant a generic square root implementation here, in order to avoid
kono
parents:
diff changeset
70 -- instantiating a complete copy of Generic_Elementary_Functions.
kono
parents:
diff changeset
71 -- Speed of the square root is not a big concern here.
kono
parents:
diff changeset
72
kono
parents:
diff changeset
73 function Sqrt is new Ops.Sqrt (Real'Base);
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 -- Instantiating the following subprograms directly would lead to
kono
parents:
diff changeset
76 -- name clashes, so use a local package.
kono
parents:
diff changeset
77
kono
parents:
diff changeset
78 package Instantiations is
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 ---------
kono
parents:
diff changeset
81 -- "*" --
kono
parents:
diff changeset
82 ---------
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 function "*" is new Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
85 (Left_Scalar => Complex,
kono
parents:
diff changeset
86 Right_Scalar => Complex,
kono
parents:
diff changeset
87 Result_Scalar => Complex,
kono
parents:
diff changeset
88 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
89 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
90 Operation => "*");
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 function "*" is new Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
93 (Left_Scalar => Complex,
kono
parents:
diff changeset
94 Right_Scalar => Real'Base,
kono
parents:
diff changeset
95 Result_Scalar => Complex,
kono
parents:
diff changeset
96 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
97 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
98 Operation => "*");
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 function "*" is new Scalar_Vector_Elementwise_Operation
kono
parents:
diff changeset
101 (Left_Scalar => Complex,
kono
parents:
diff changeset
102 Right_Scalar => Complex,
kono
parents:
diff changeset
103 Result_Scalar => Complex,
kono
parents:
diff changeset
104 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
105 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
106 Operation => "*");
kono
parents:
diff changeset
107
kono
parents:
diff changeset
108 function "*" is new Scalar_Vector_Elementwise_Operation
kono
parents:
diff changeset
109 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
110 Right_Scalar => Complex,
kono
parents:
diff changeset
111 Result_Scalar => Complex,
kono
parents:
diff changeset
112 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
113 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
114 Operation => "*");
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116 function "*" is new Inner_Product
kono
parents:
diff changeset
117 (Left_Scalar => Complex,
kono
parents:
diff changeset
118 Right_Scalar => Real'Base,
kono
parents:
diff changeset
119 Result_Scalar => Complex,
kono
parents:
diff changeset
120 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
121 Right_Vector => Real_Vector,
kono
parents:
diff changeset
122 Zero => (0.0, 0.0));
kono
parents:
diff changeset
123
kono
parents:
diff changeset
124 function "*" is new Inner_Product
kono
parents:
diff changeset
125 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
126 Right_Scalar => Complex,
kono
parents:
diff changeset
127 Result_Scalar => Complex,
kono
parents:
diff changeset
128 Left_Vector => Real_Vector,
kono
parents:
diff changeset
129 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
130 Zero => (0.0, 0.0));
kono
parents:
diff changeset
131
kono
parents:
diff changeset
132 function "*" is new Inner_Product
kono
parents:
diff changeset
133 (Left_Scalar => Complex,
kono
parents:
diff changeset
134 Right_Scalar => Complex,
kono
parents:
diff changeset
135 Result_Scalar => Complex,
kono
parents:
diff changeset
136 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
137 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
138 Zero => (0.0, 0.0));
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 function "*" is new Outer_Product
kono
parents:
diff changeset
141 (Left_Scalar => Complex,
kono
parents:
diff changeset
142 Right_Scalar => Complex,
kono
parents:
diff changeset
143 Result_Scalar => Complex,
kono
parents:
diff changeset
144 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
145 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
146 Matrix => Complex_Matrix);
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148 function "*" is new Outer_Product
kono
parents:
diff changeset
149 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
150 Right_Scalar => Complex,
kono
parents:
diff changeset
151 Result_Scalar => Complex,
kono
parents:
diff changeset
152 Left_Vector => Real_Vector,
kono
parents:
diff changeset
153 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
154 Matrix => Complex_Matrix);
kono
parents:
diff changeset
155
kono
parents:
diff changeset
156 function "*" is new Outer_Product
kono
parents:
diff changeset
157 (Left_Scalar => Complex,
kono
parents:
diff changeset
158 Right_Scalar => Real'Base,
kono
parents:
diff changeset
159 Result_Scalar => Complex,
kono
parents:
diff changeset
160 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
161 Right_Vector => Real_Vector,
kono
parents:
diff changeset
162 Matrix => Complex_Matrix);
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 function "*" is new Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
165 (Left_Scalar => Complex,
kono
parents:
diff changeset
166 Right_Scalar => Complex,
kono
parents:
diff changeset
167 Result_Scalar => Complex,
kono
parents:
diff changeset
168 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
169 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
170 Operation => "*");
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 function "*" is new Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
173 (Left_Scalar => Complex,
kono
parents:
diff changeset
174 Right_Scalar => Real'Base,
kono
parents:
diff changeset
175 Result_Scalar => Complex,
kono
parents:
diff changeset
176 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
177 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
178 Operation => "*");
kono
parents:
diff changeset
179
kono
parents:
diff changeset
180 function "*" is new Scalar_Matrix_Elementwise_Operation
kono
parents:
diff changeset
181 (Left_Scalar => Complex,
kono
parents:
diff changeset
182 Right_Scalar => Complex,
kono
parents:
diff changeset
183 Result_Scalar => Complex,
kono
parents:
diff changeset
184 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
185 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
186 Operation => "*");
kono
parents:
diff changeset
187
kono
parents:
diff changeset
188 function "*" is new Scalar_Matrix_Elementwise_Operation
kono
parents:
diff changeset
189 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
190 Right_Scalar => Complex,
kono
parents:
diff changeset
191 Result_Scalar => Complex,
kono
parents:
diff changeset
192 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
193 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
194 Operation => "*");
kono
parents:
diff changeset
195
kono
parents:
diff changeset
196 function "*" is new Matrix_Vector_Product
kono
parents:
diff changeset
197 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
198 Right_Scalar => Complex,
kono
parents:
diff changeset
199 Result_Scalar => Complex,
kono
parents:
diff changeset
200 Matrix => Real_Matrix,
kono
parents:
diff changeset
201 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
202 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
203 Zero => (0.0, 0.0));
kono
parents:
diff changeset
204
kono
parents:
diff changeset
205 function "*" is new Matrix_Vector_Product
kono
parents:
diff changeset
206 (Left_Scalar => Complex,
kono
parents:
diff changeset
207 Right_Scalar => Real'Base,
kono
parents:
diff changeset
208 Result_Scalar => Complex,
kono
parents:
diff changeset
209 Matrix => Complex_Matrix,
kono
parents:
diff changeset
210 Right_Vector => Real_Vector,
kono
parents:
diff changeset
211 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
212 Zero => (0.0, 0.0));
kono
parents:
diff changeset
213
kono
parents:
diff changeset
214 function "*" is new Matrix_Vector_Product
kono
parents:
diff changeset
215 (Left_Scalar => Complex,
kono
parents:
diff changeset
216 Right_Scalar => Complex,
kono
parents:
diff changeset
217 Result_Scalar => Complex,
kono
parents:
diff changeset
218 Matrix => Complex_Matrix,
kono
parents:
diff changeset
219 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
220 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
221 Zero => (0.0, 0.0));
kono
parents:
diff changeset
222
kono
parents:
diff changeset
223 function "*" is new Vector_Matrix_Product
kono
parents:
diff changeset
224 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
225 Right_Scalar => Complex,
kono
parents:
diff changeset
226 Result_Scalar => Complex,
kono
parents:
diff changeset
227 Left_Vector => Real_Vector,
kono
parents:
diff changeset
228 Matrix => Complex_Matrix,
kono
parents:
diff changeset
229 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
230 Zero => (0.0, 0.0));
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 function "*" is new Vector_Matrix_Product
kono
parents:
diff changeset
233 (Left_Scalar => Complex,
kono
parents:
diff changeset
234 Right_Scalar => Real'Base,
kono
parents:
diff changeset
235 Result_Scalar => Complex,
kono
parents:
diff changeset
236 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
237 Matrix => Real_Matrix,
kono
parents:
diff changeset
238 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
239 Zero => (0.0, 0.0));
kono
parents:
diff changeset
240
kono
parents:
diff changeset
241 function "*" is new Vector_Matrix_Product
kono
parents:
diff changeset
242 (Left_Scalar => Complex,
kono
parents:
diff changeset
243 Right_Scalar => Complex,
kono
parents:
diff changeset
244 Result_Scalar => Complex,
kono
parents:
diff changeset
245 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
246 Matrix => Complex_Matrix,
kono
parents:
diff changeset
247 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
248 Zero => (0.0, 0.0));
kono
parents:
diff changeset
249
kono
parents:
diff changeset
250 function "*" is new Matrix_Matrix_Product
kono
parents:
diff changeset
251 (Left_Scalar => Complex,
kono
parents:
diff changeset
252 Right_Scalar => Complex,
kono
parents:
diff changeset
253 Result_Scalar => Complex,
kono
parents:
diff changeset
254 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
255 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
256 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
257 Zero => (0.0, 0.0));
kono
parents:
diff changeset
258
kono
parents:
diff changeset
259 function "*" is new Matrix_Matrix_Product
kono
parents:
diff changeset
260 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
261 Right_Scalar => Complex,
kono
parents:
diff changeset
262 Result_Scalar => Complex,
kono
parents:
diff changeset
263 Left_Matrix => Real_Matrix,
kono
parents:
diff changeset
264 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
265 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
266 Zero => (0.0, 0.0));
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 function "*" is new Matrix_Matrix_Product
kono
parents:
diff changeset
269 (Left_Scalar => Complex,
kono
parents:
diff changeset
270 Right_Scalar => Real'Base,
kono
parents:
diff changeset
271 Result_Scalar => Complex,
kono
parents:
diff changeset
272 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
273 Right_Matrix => Real_Matrix,
kono
parents:
diff changeset
274 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
275 Zero => (0.0, 0.0));
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 ---------
kono
parents:
diff changeset
278 -- "+" --
kono
parents:
diff changeset
279 ---------
kono
parents:
diff changeset
280
kono
parents:
diff changeset
281 function "+" is new Vector_Elementwise_Operation
kono
parents:
diff changeset
282 (X_Scalar => Complex,
kono
parents:
diff changeset
283 Result_Scalar => Complex,
kono
parents:
diff changeset
284 X_Vector => Complex_Vector,
kono
parents:
diff changeset
285 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
286 Operation => "+");
kono
parents:
diff changeset
287
kono
parents:
diff changeset
288 function "+" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
289 (Left_Scalar => Complex,
kono
parents:
diff changeset
290 Right_Scalar => Complex,
kono
parents:
diff changeset
291 Result_Scalar => Complex,
kono
parents:
diff changeset
292 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
293 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
294 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
295 Operation => "+");
kono
parents:
diff changeset
296
kono
parents:
diff changeset
297 function "+" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
298 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
299 Right_Scalar => Complex,
kono
parents:
diff changeset
300 Result_Scalar => Complex,
kono
parents:
diff changeset
301 Left_Vector => Real_Vector,
kono
parents:
diff changeset
302 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
303 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
304 Operation => "+");
kono
parents:
diff changeset
305
kono
parents:
diff changeset
306 function "+" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
307 (Left_Scalar => Complex,
kono
parents:
diff changeset
308 Right_Scalar => Real'Base,
kono
parents:
diff changeset
309 Result_Scalar => Complex,
kono
parents:
diff changeset
310 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
311 Right_Vector => Real_Vector,
kono
parents:
diff changeset
312 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
313 Operation => "+");
kono
parents:
diff changeset
314
kono
parents:
diff changeset
315 function "+" is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
316 (X_Scalar => Complex,
kono
parents:
diff changeset
317 Result_Scalar => Complex,
kono
parents:
diff changeset
318 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
319 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
320 Operation => "+");
kono
parents:
diff changeset
321
kono
parents:
diff changeset
322 function "+" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
323 (Left_Scalar => Complex,
kono
parents:
diff changeset
324 Right_Scalar => Complex,
kono
parents:
diff changeset
325 Result_Scalar => Complex,
kono
parents:
diff changeset
326 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
327 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
328 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
329 Operation => "+");
kono
parents:
diff changeset
330
kono
parents:
diff changeset
331 function "+" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
332 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
333 Right_Scalar => Complex,
kono
parents:
diff changeset
334 Result_Scalar => Complex,
kono
parents:
diff changeset
335 Left_Matrix => Real_Matrix,
kono
parents:
diff changeset
336 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
337 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
338 Operation => "+");
kono
parents:
diff changeset
339
kono
parents:
diff changeset
340 function "+" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
341 (Left_Scalar => Complex,
kono
parents:
diff changeset
342 Right_Scalar => Real'Base,
kono
parents:
diff changeset
343 Result_Scalar => Complex,
kono
parents:
diff changeset
344 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
345 Right_Matrix => Real_Matrix,
kono
parents:
diff changeset
346 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
347 Operation => "+");
kono
parents:
diff changeset
348
kono
parents:
diff changeset
349 ---------
kono
parents:
diff changeset
350 -- "-" --
kono
parents:
diff changeset
351 ---------
kono
parents:
diff changeset
352
kono
parents:
diff changeset
353 function "-" is new Vector_Elementwise_Operation
kono
parents:
diff changeset
354 (X_Scalar => Complex,
kono
parents:
diff changeset
355 Result_Scalar => Complex,
kono
parents:
diff changeset
356 X_Vector => Complex_Vector,
kono
parents:
diff changeset
357 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
358 Operation => "-");
kono
parents:
diff changeset
359
kono
parents:
diff changeset
360 function "-" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
361 (Left_Scalar => Complex,
kono
parents:
diff changeset
362 Right_Scalar => Complex,
kono
parents:
diff changeset
363 Result_Scalar => Complex,
kono
parents:
diff changeset
364 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
365 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
366 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
367 Operation => "-");
kono
parents:
diff changeset
368
kono
parents:
diff changeset
369 function "-" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
370 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
371 Right_Scalar => Complex,
kono
parents:
diff changeset
372 Result_Scalar => Complex,
kono
parents:
diff changeset
373 Left_Vector => Real_Vector,
kono
parents:
diff changeset
374 Right_Vector => Complex_Vector,
kono
parents:
diff changeset
375 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
376 Operation => "-");
kono
parents:
diff changeset
377
kono
parents:
diff changeset
378 function "-" is new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
379 (Left_Scalar => Complex,
kono
parents:
diff changeset
380 Right_Scalar => Real'Base,
kono
parents:
diff changeset
381 Result_Scalar => Complex,
kono
parents:
diff changeset
382 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
383 Right_Vector => Real_Vector,
kono
parents:
diff changeset
384 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
385 Operation => "-");
kono
parents:
diff changeset
386
kono
parents:
diff changeset
387 function "-" is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
388 (X_Scalar => Complex,
kono
parents:
diff changeset
389 Result_Scalar => Complex,
kono
parents:
diff changeset
390 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
391 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
392 Operation => "-");
kono
parents:
diff changeset
393
kono
parents:
diff changeset
394 function "-" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
395 (Left_Scalar => Complex,
kono
parents:
diff changeset
396 Right_Scalar => Complex,
kono
parents:
diff changeset
397 Result_Scalar => Complex,
kono
parents:
diff changeset
398 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
399 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
400 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
401 Operation => "-");
kono
parents:
diff changeset
402
kono
parents:
diff changeset
403 function "-" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
404 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
405 Right_Scalar => Complex,
kono
parents:
diff changeset
406 Result_Scalar => Complex,
kono
parents:
diff changeset
407 Left_Matrix => Real_Matrix,
kono
parents:
diff changeset
408 Right_Matrix => Complex_Matrix,
kono
parents:
diff changeset
409 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
410 Operation => "-");
kono
parents:
diff changeset
411
kono
parents:
diff changeset
412 function "-" is new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
413 (Left_Scalar => Complex,
kono
parents:
diff changeset
414 Right_Scalar => Real'Base,
kono
parents:
diff changeset
415 Result_Scalar => Complex,
kono
parents:
diff changeset
416 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
417 Right_Matrix => Real_Matrix,
kono
parents:
diff changeset
418 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
419 Operation => "-");
kono
parents:
diff changeset
420
kono
parents:
diff changeset
421 ---------
kono
parents:
diff changeset
422 -- "/" --
kono
parents:
diff changeset
423 ---------
kono
parents:
diff changeset
424
kono
parents:
diff changeset
425 function "/" is new Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
426 (Left_Scalar => Complex,
kono
parents:
diff changeset
427 Right_Scalar => Complex,
kono
parents:
diff changeset
428 Result_Scalar => Complex,
kono
parents:
diff changeset
429 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
430 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
431 Operation => "/");
kono
parents:
diff changeset
432
kono
parents:
diff changeset
433 function "/" is new Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
434 (Left_Scalar => Complex,
kono
parents:
diff changeset
435 Right_Scalar => Real'Base,
kono
parents:
diff changeset
436 Result_Scalar => Complex,
kono
parents:
diff changeset
437 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
438 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
439 Operation => "/");
kono
parents:
diff changeset
440
kono
parents:
diff changeset
441 function "/" is new Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
442 (Left_Scalar => Complex,
kono
parents:
diff changeset
443 Right_Scalar => Complex,
kono
parents:
diff changeset
444 Result_Scalar => Complex,
kono
parents:
diff changeset
445 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
446 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
447 Operation => "/");
kono
parents:
diff changeset
448
kono
parents:
diff changeset
449 function "/" is new Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
450 (Left_Scalar => Complex,
kono
parents:
diff changeset
451 Right_Scalar => Real'Base,
kono
parents:
diff changeset
452 Result_Scalar => Complex,
kono
parents:
diff changeset
453 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
454 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
455 Operation => "/");
kono
parents:
diff changeset
456
kono
parents:
diff changeset
457 -----------
kono
parents:
diff changeset
458 -- "abs" --
kono
parents:
diff changeset
459 -----------
kono
parents:
diff changeset
460
kono
parents:
diff changeset
461 function "abs" is new L2_Norm
kono
parents:
diff changeset
462 (X_Scalar => Complex,
kono
parents:
diff changeset
463 Result_Real => Real'Base,
kono
parents:
diff changeset
464 X_Vector => Complex_Vector);
kono
parents:
diff changeset
465
kono
parents:
diff changeset
466 --------------
kono
parents:
diff changeset
467 -- Argument --
kono
parents:
diff changeset
468 --------------
kono
parents:
diff changeset
469
kono
parents:
diff changeset
470 function Argument is new Vector_Elementwise_Operation
kono
parents:
diff changeset
471 (X_Scalar => Complex,
kono
parents:
diff changeset
472 Result_Scalar => Real'Base,
kono
parents:
diff changeset
473 X_Vector => Complex_Vector,
kono
parents:
diff changeset
474 Result_Vector => Real_Vector,
kono
parents:
diff changeset
475 Operation => Argument);
kono
parents:
diff changeset
476
kono
parents:
diff changeset
477 function Argument is new Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
478 (Left_Scalar => Complex,
kono
parents:
diff changeset
479 Right_Scalar => Real'Base,
kono
parents:
diff changeset
480 Result_Scalar => Real'Base,
kono
parents:
diff changeset
481 Left_Vector => Complex_Vector,
kono
parents:
diff changeset
482 Result_Vector => Real_Vector,
kono
parents:
diff changeset
483 Operation => Argument);
kono
parents:
diff changeset
484
kono
parents:
diff changeset
485 function Argument is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
486 (X_Scalar => Complex,
kono
parents:
diff changeset
487 Result_Scalar => Real'Base,
kono
parents:
diff changeset
488 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
489 Result_Matrix => Real_Matrix,
kono
parents:
diff changeset
490 Operation => Argument);
kono
parents:
diff changeset
491
kono
parents:
diff changeset
492 function Argument is new Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
493 (Left_Scalar => Complex,
kono
parents:
diff changeset
494 Right_Scalar => Real'Base,
kono
parents:
diff changeset
495 Result_Scalar => Real'Base,
kono
parents:
diff changeset
496 Left_Matrix => Complex_Matrix,
kono
parents:
diff changeset
497 Result_Matrix => Real_Matrix,
kono
parents:
diff changeset
498 Operation => Argument);
kono
parents:
diff changeset
499
kono
parents:
diff changeset
500 ----------------------------
kono
parents:
diff changeset
501 -- Compose_From_Cartesian --
kono
parents:
diff changeset
502 ----------------------------
kono
parents:
diff changeset
503
kono
parents:
diff changeset
504 function Compose_From_Cartesian is new Vector_Elementwise_Operation
kono
parents:
diff changeset
505 (X_Scalar => Real'Base,
kono
parents:
diff changeset
506 Result_Scalar => Complex,
kono
parents:
diff changeset
507 X_Vector => Real_Vector,
kono
parents:
diff changeset
508 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
509 Operation => Compose_From_Cartesian);
kono
parents:
diff changeset
510
kono
parents:
diff changeset
511 function Compose_From_Cartesian is
kono
parents:
diff changeset
512 new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
513 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
514 Right_Scalar => Real'Base,
kono
parents:
diff changeset
515 Result_Scalar => Complex,
kono
parents:
diff changeset
516 Left_Vector => Real_Vector,
kono
parents:
diff changeset
517 Right_Vector => Real_Vector,
kono
parents:
diff changeset
518 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
519 Operation => Compose_From_Cartesian);
kono
parents:
diff changeset
520
kono
parents:
diff changeset
521 function Compose_From_Cartesian is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
522 (X_Scalar => Real'Base,
kono
parents:
diff changeset
523 Result_Scalar => Complex,
kono
parents:
diff changeset
524 X_Matrix => Real_Matrix,
kono
parents:
diff changeset
525 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
526 Operation => Compose_From_Cartesian);
kono
parents:
diff changeset
527
kono
parents:
diff changeset
528 function Compose_From_Cartesian is
kono
parents:
diff changeset
529 new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
530 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
531 Right_Scalar => Real'Base,
kono
parents:
diff changeset
532 Result_Scalar => Complex,
kono
parents:
diff changeset
533 Left_Matrix => Real_Matrix,
kono
parents:
diff changeset
534 Right_Matrix => Real_Matrix,
kono
parents:
diff changeset
535 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
536 Operation => Compose_From_Cartesian);
kono
parents:
diff changeset
537
kono
parents:
diff changeset
538 ------------------------
kono
parents:
diff changeset
539 -- Compose_From_Polar --
kono
parents:
diff changeset
540 ------------------------
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 function Compose_From_Polar is
kono
parents:
diff changeset
543 new Vector_Vector_Elementwise_Operation
kono
parents:
diff changeset
544 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
545 Right_Scalar => Real'Base,
kono
parents:
diff changeset
546 Result_Scalar => Complex,
kono
parents:
diff changeset
547 Left_Vector => Real_Vector,
kono
parents:
diff changeset
548 Right_Vector => Real_Vector,
kono
parents:
diff changeset
549 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
550 Operation => Compose_From_Polar);
kono
parents:
diff changeset
551
kono
parents:
diff changeset
552 function Compose_From_Polar is
kono
parents:
diff changeset
553 new Vector_Vector_Scalar_Elementwise_Operation
kono
parents:
diff changeset
554 (X_Scalar => Real'Base,
kono
parents:
diff changeset
555 Y_Scalar => Real'Base,
kono
parents:
diff changeset
556 Z_Scalar => Real'Base,
kono
parents:
diff changeset
557 Result_Scalar => Complex,
kono
parents:
diff changeset
558 X_Vector => Real_Vector,
kono
parents:
diff changeset
559 Y_Vector => Real_Vector,
kono
parents:
diff changeset
560 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
561 Operation => Compose_From_Polar);
kono
parents:
diff changeset
562
kono
parents:
diff changeset
563 function Compose_From_Polar is
kono
parents:
diff changeset
564 new Matrix_Matrix_Elementwise_Operation
kono
parents:
diff changeset
565 (Left_Scalar => Real'Base,
kono
parents:
diff changeset
566 Right_Scalar => Real'Base,
kono
parents:
diff changeset
567 Result_Scalar => Complex,
kono
parents:
diff changeset
568 Left_Matrix => Real_Matrix,
kono
parents:
diff changeset
569 Right_Matrix => Real_Matrix,
kono
parents:
diff changeset
570 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
571 Operation => Compose_From_Polar);
kono
parents:
diff changeset
572
kono
parents:
diff changeset
573 function Compose_From_Polar is
kono
parents:
diff changeset
574 new Matrix_Matrix_Scalar_Elementwise_Operation
kono
parents:
diff changeset
575 (X_Scalar => Real'Base,
kono
parents:
diff changeset
576 Y_Scalar => Real'Base,
kono
parents:
diff changeset
577 Z_Scalar => Real'Base,
kono
parents:
diff changeset
578 Result_Scalar => Complex,
kono
parents:
diff changeset
579 X_Matrix => Real_Matrix,
kono
parents:
diff changeset
580 Y_Matrix => Real_Matrix,
kono
parents:
diff changeset
581 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
582 Operation => Compose_From_Polar);
kono
parents:
diff changeset
583
kono
parents:
diff changeset
584 ---------------
kono
parents:
diff changeset
585 -- Conjugate --
kono
parents:
diff changeset
586 ---------------
kono
parents:
diff changeset
587
kono
parents:
diff changeset
588 function Conjugate is new Vector_Elementwise_Operation
kono
parents:
diff changeset
589 (X_Scalar => Complex,
kono
parents:
diff changeset
590 Result_Scalar => Complex,
kono
parents:
diff changeset
591 X_Vector => Complex_Vector,
kono
parents:
diff changeset
592 Result_Vector => Complex_Vector,
kono
parents:
diff changeset
593 Operation => Conjugate);
kono
parents:
diff changeset
594
kono
parents:
diff changeset
595 function Conjugate is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
596 (X_Scalar => Complex,
kono
parents:
diff changeset
597 Result_Scalar => Complex,
kono
parents:
diff changeset
598 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
599 Result_Matrix => Complex_Matrix,
kono
parents:
diff changeset
600 Operation => Conjugate);
kono
parents:
diff changeset
601
kono
parents:
diff changeset
602 --------
kono
parents:
diff changeset
603 -- Im --
kono
parents:
diff changeset
604 --------
kono
parents:
diff changeset
605
kono
parents:
diff changeset
606 function Im is new Vector_Elementwise_Operation
kono
parents:
diff changeset
607 (X_Scalar => Complex,
kono
parents:
diff changeset
608 Result_Scalar => Real'Base,
kono
parents:
diff changeset
609 X_Vector => Complex_Vector,
kono
parents:
diff changeset
610 Result_Vector => Real_Vector,
kono
parents:
diff changeset
611 Operation => Im);
kono
parents:
diff changeset
612
kono
parents:
diff changeset
613 function Im is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
614 (X_Scalar => Complex,
kono
parents:
diff changeset
615 Result_Scalar => Real'Base,
kono
parents:
diff changeset
616 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
617 Result_Matrix => Real_Matrix,
kono
parents:
diff changeset
618 Operation => Im);
kono
parents:
diff changeset
619
kono
parents:
diff changeset
620 -------------
kono
parents:
diff changeset
621 -- Modulus --
kono
parents:
diff changeset
622 -------------
kono
parents:
diff changeset
623
kono
parents:
diff changeset
624 function Modulus is new Vector_Elementwise_Operation
kono
parents:
diff changeset
625 (X_Scalar => Complex,
kono
parents:
diff changeset
626 Result_Scalar => Real'Base,
kono
parents:
diff changeset
627 X_Vector => Complex_Vector,
kono
parents:
diff changeset
628 Result_Vector => Real_Vector,
kono
parents:
diff changeset
629 Operation => Modulus);
kono
parents:
diff changeset
630
kono
parents:
diff changeset
631 function Modulus is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
632 (X_Scalar => Complex,
kono
parents:
diff changeset
633 Result_Scalar => Real'Base,
kono
parents:
diff changeset
634 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
635 Result_Matrix => Real_Matrix,
kono
parents:
diff changeset
636 Operation => Modulus);
kono
parents:
diff changeset
637
kono
parents:
diff changeset
638 --------
kono
parents:
diff changeset
639 -- Re --
kono
parents:
diff changeset
640 --------
kono
parents:
diff changeset
641
kono
parents:
diff changeset
642 function Re is new Vector_Elementwise_Operation
kono
parents:
diff changeset
643 (X_Scalar => Complex,
kono
parents:
diff changeset
644 Result_Scalar => Real'Base,
kono
parents:
diff changeset
645 X_Vector => Complex_Vector,
kono
parents:
diff changeset
646 Result_Vector => Real_Vector,
kono
parents:
diff changeset
647 Operation => Re);
kono
parents:
diff changeset
648
kono
parents:
diff changeset
649 function Re is new Matrix_Elementwise_Operation
kono
parents:
diff changeset
650 (X_Scalar => Complex,
kono
parents:
diff changeset
651 Result_Scalar => Real'Base,
kono
parents:
diff changeset
652 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
653 Result_Matrix => Real_Matrix,
kono
parents:
diff changeset
654 Operation => Re);
kono
parents:
diff changeset
655
kono
parents:
diff changeset
656 ------------
kono
parents:
diff changeset
657 -- Set_Im --
kono
parents:
diff changeset
658 ------------
kono
parents:
diff changeset
659
kono
parents:
diff changeset
660 procedure Set_Im is new Update_Vector_With_Vector
kono
parents:
diff changeset
661 (X_Scalar => Complex,
kono
parents:
diff changeset
662 Y_Scalar => Real'Base,
kono
parents:
diff changeset
663 X_Vector => Complex_Vector,
kono
parents:
diff changeset
664 Y_Vector => Real_Vector,
kono
parents:
diff changeset
665 Update => Set_Im);
kono
parents:
diff changeset
666
kono
parents:
diff changeset
667 procedure Set_Im is new Update_Matrix_With_Matrix
kono
parents:
diff changeset
668 (X_Scalar => Complex,
kono
parents:
diff changeset
669 Y_Scalar => Real'Base,
kono
parents:
diff changeset
670 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
671 Y_Matrix => Real_Matrix,
kono
parents:
diff changeset
672 Update => Set_Im);
kono
parents:
diff changeset
673
kono
parents:
diff changeset
674 ------------
kono
parents:
diff changeset
675 -- Set_Re --
kono
parents:
diff changeset
676 ------------
kono
parents:
diff changeset
677
kono
parents:
diff changeset
678 procedure Set_Re is new Update_Vector_With_Vector
kono
parents:
diff changeset
679 (X_Scalar => Complex,
kono
parents:
diff changeset
680 Y_Scalar => Real'Base,
kono
parents:
diff changeset
681 X_Vector => Complex_Vector,
kono
parents:
diff changeset
682 Y_Vector => Real_Vector,
kono
parents:
diff changeset
683 Update => Set_Re);
kono
parents:
diff changeset
684
kono
parents:
diff changeset
685 procedure Set_Re is new Update_Matrix_With_Matrix
kono
parents:
diff changeset
686 (X_Scalar => Complex,
kono
parents:
diff changeset
687 Y_Scalar => Real'Base,
kono
parents:
diff changeset
688 X_Matrix => Complex_Matrix,
kono
parents:
diff changeset
689 Y_Matrix => Real_Matrix,
kono
parents:
diff changeset
690 Update => Set_Re);
kono
parents:
diff changeset
691
kono
parents:
diff changeset
692 -----------
kono
parents:
diff changeset
693 -- Solve --
kono
parents:
diff changeset
694 -----------
kono
parents:
diff changeset
695
kono
parents:
diff changeset
696 function Solve is new Matrix_Vector_Solution
kono
parents:
diff changeset
697 (Complex, (0.0, 0.0), Complex_Vector, Complex_Matrix);
kono
parents:
diff changeset
698
kono
parents:
diff changeset
699 function Solve is new Matrix_Matrix_Solution
kono
parents:
diff changeset
700 (Complex, (0.0, 0.0), Complex_Matrix);
kono
parents:
diff changeset
701
kono
parents:
diff changeset
702 -----------------
kono
parents:
diff changeset
703 -- Unit_Matrix --
kono
parents:
diff changeset
704 -----------------
kono
parents:
diff changeset
705
kono
parents:
diff changeset
706 function Unit_Matrix is new System.Generic_Array_Operations.Unit_Matrix
kono
parents:
diff changeset
707 (Scalar => Complex,
kono
parents:
diff changeset
708 Matrix => Complex_Matrix,
kono
parents:
diff changeset
709 Zero => (0.0, 0.0),
kono
parents:
diff changeset
710 One => (1.0, 0.0));
kono
parents:
diff changeset
711
kono
parents:
diff changeset
712 function Unit_Vector is new System.Generic_Array_Operations.Unit_Vector
kono
parents:
diff changeset
713 (Scalar => Complex,
kono
parents:
diff changeset
714 Vector => Complex_Vector,
kono
parents:
diff changeset
715 Zero => (0.0, 0.0),
kono
parents:
diff changeset
716 One => (1.0, 0.0));
kono
parents:
diff changeset
717 end Instantiations;
kono
parents:
diff changeset
718
kono
parents:
diff changeset
719 ---------
kono
parents:
diff changeset
720 -- "*" --
kono
parents:
diff changeset
721 ---------
kono
parents:
diff changeset
722
kono
parents:
diff changeset
723 function "*"
kono
parents:
diff changeset
724 (Left : Complex_Vector;
kono
parents:
diff changeset
725 Right : Complex_Vector) return Complex
kono
parents:
diff changeset
726 renames Instantiations."*";
kono
parents:
diff changeset
727
kono
parents:
diff changeset
728 function "*"
kono
parents:
diff changeset
729 (Left : Real_Vector;
kono
parents:
diff changeset
730 Right : Complex_Vector) return Complex
kono
parents:
diff changeset
731 renames Instantiations."*";
kono
parents:
diff changeset
732
kono
parents:
diff changeset
733 function "*"
kono
parents:
diff changeset
734 (Left : Complex_Vector;
kono
parents:
diff changeset
735 Right : Real_Vector) return Complex
kono
parents:
diff changeset
736 renames Instantiations."*";
kono
parents:
diff changeset
737
kono
parents:
diff changeset
738 function "*"
kono
parents:
diff changeset
739 (Left : Complex;
kono
parents:
diff changeset
740 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
741 renames Instantiations."*";
kono
parents:
diff changeset
742
kono
parents:
diff changeset
743 function "*"
kono
parents:
diff changeset
744 (Left : Complex_Vector;
kono
parents:
diff changeset
745 Right : Complex) return Complex_Vector
kono
parents:
diff changeset
746 renames Instantiations."*";
kono
parents:
diff changeset
747
kono
parents:
diff changeset
748 function "*"
kono
parents:
diff changeset
749 (Left : Real'Base;
kono
parents:
diff changeset
750 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
751 renames Instantiations."*";
kono
parents:
diff changeset
752
kono
parents:
diff changeset
753 function "*"
kono
parents:
diff changeset
754 (Left : Complex_Vector;
kono
parents:
diff changeset
755 Right : Real'Base) return Complex_Vector
kono
parents:
diff changeset
756 renames Instantiations."*";
kono
parents:
diff changeset
757
kono
parents:
diff changeset
758 function "*"
kono
parents:
diff changeset
759 (Left : Complex_Matrix;
kono
parents:
diff changeset
760 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
761 renames Instantiations."*";
kono
parents:
diff changeset
762
kono
parents:
diff changeset
763 function "*"
kono
parents:
diff changeset
764 (Left : Complex_Vector;
kono
parents:
diff changeset
765 Right : Complex_Vector) return Complex_Matrix
kono
parents:
diff changeset
766 renames Instantiations."*";
kono
parents:
diff changeset
767
kono
parents:
diff changeset
768 function "*"
kono
parents:
diff changeset
769 (Left : Complex_Vector;
kono
parents:
diff changeset
770 Right : Complex_Matrix) return Complex_Vector
kono
parents:
diff changeset
771 renames Instantiations."*";
kono
parents:
diff changeset
772
kono
parents:
diff changeset
773 function "*"
kono
parents:
diff changeset
774 (Left : Complex_Matrix;
kono
parents:
diff changeset
775 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
776 renames Instantiations."*";
kono
parents:
diff changeset
777
kono
parents:
diff changeset
778 function "*"
kono
parents:
diff changeset
779 (Left : Real_Matrix;
kono
parents:
diff changeset
780 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
781 renames Instantiations."*";
kono
parents:
diff changeset
782
kono
parents:
diff changeset
783 function "*"
kono
parents:
diff changeset
784 (Left : Complex_Matrix;
kono
parents:
diff changeset
785 Right : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
786 renames Instantiations."*";
kono
parents:
diff changeset
787
kono
parents:
diff changeset
788 function "*"
kono
parents:
diff changeset
789 (Left : Real_Vector;
kono
parents:
diff changeset
790 Right : Complex_Vector) return Complex_Matrix
kono
parents:
diff changeset
791 renames Instantiations."*";
kono
parents:
diff changeset
792
kono
parents:
diff changeset
793 function "*"
kono
parents:
diff changeset
794 (Left : Complex_Vector;
kono
parents:
diff changeset
795 Right : Real_Vector) return Complex_Matrix
kono
parents:
diff changeset
796 renames Instantiations."*";
kono
parents:
diff changeset
797
kono
parents:
diff changeset
798 function "*"
kono
parents:
diff changeset
799 (Left : Real_Vector;
kono
parents:
diff changeset
800 Right : Complex_Matrix) return Complex_Vector
kono
parents:
diff changeset
801 renames Instantiations."*";
kono
parents:
diff changeset
802
kono
parents:
diff changeset
803 function "*"
kono
parents:
diff changeset
804 (Left : Complex_Vector;
kono
parents:
diff changeset
805 Right : Real_Matrix) return Complex_Vector
kono
parents:
diff changeset
806 renames Instantiations."*";
kono
parents:
diff changeset
807
kono
parents:
diff changeset
808 function "*"
kono
parents:
diff changeset
809 (Left : Real_Matrix;
kono
parents:
diff changeset
810 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
811 renames Instantiations."*";
kono
parents:
diff changeset
812
kono
parents:
diff changeset
813 function "*"
kono
parents:
diff changeset
814 (Left : Complex_Matrix;
kono
parents:
diff changeset
815 Right : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
816 renames Instantiations."*";
kono
parents:
diff changeset
817
kono
parents:
diff changeset
818 function "*"
kono
parents:
diff changeset
819 (Left : Complex;
kono
parents:
diff changeset
820 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
821 renames Instantiations."*";
kono
parents:
diff changeset
822
kono
parents:
diff changeset
823 function "*"
kono
parents:
diff changeset
824 (Left : Complex_Matrix;
kono
parents:
diff changeset
825 Right : Complex) return Complex_Matrix
kono
parents:
diff changeset
826 renames Instantiations."*";
kono
parents:
diff changeset
827
kono
parents:
diff changeset
828 function "*"
kono
parents:
diff changeset
829 (Left : Real'Base;
kono
parents:
diff changeset
830 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
831 renames Instantiations."*";
kono
parents:
diff changeset
832
kono
parents:
diff changeset
833 function "*"
kono
parents:
diff changeset
834 (Left : Complex_Matrix;
kono
parents:
diff changeset
835 Right : Real'Base) return Complex_Matrix
kono
parents:
diff changeset
836 renames Instantiations."*";
kono
parents:
diff changeset
837
kono
parents:
diff changeset
838 ---------
kono
parents:
diff changeset
839 -- "+" --
kono
parents:
diff changeset
840 ---------
kono
parents:
diff changeset
841
kono
parents:
diff changeset
842 function "+" (Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
843 renames Instantiations."+";
kono
parents:
diff changeset
844
kono
parents:
diff changeset
845 function "+"
kono
parents:
diff changeset
846 (Left : Complex_Vector;
kono
parents:
diff changeset
847 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
848 renames Instantiations."+";
kono
parents:
diff changeset
849
kono
parents:
diff changeset
850 function "+"
kono
parents:
diff changeset
851 (Left : Real_Vector;
kono
parents:
diff changeset
852 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
853 renames Instantiations."+";
kono
parents:
diff changeset
854
kono
parents:
diff changeset
855 function "+"
kono
parents:
diff changeset
856 (Left : Complex_Vector;
kono
parents:
diff changeset
857 Right : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
858 renames Instantiations."+";
kono
parents:
diff changeset
859
kono
parents:
diff changeset
860 function "+" (Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
861 renames Instantiations."+";
kono
parents:
diff changeset
862
kono
parents:
diff changeset
863 function "+"
kono
parents:
diff changeset
864 (Left : Complex_Matrix;
kono
parents:
diff changeset
865 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
866 renames Instantiations."+";
kono
parents:
diff changeset
867
kono
parents:
diff changeset
868 function "+"
kono
parents:
diff changeset
869 (Left : Real_Matrix;
kono
parents:
diff changeset
870 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
871 renames Instantiations."+";
kono
parents:
diff changeset
872
kono
parents:
diff changeset
873 function "+"
kono
parents:
diff changeset
874 (Left : Complex_Matrix;
kono
parents:
diff changeset
875 Right : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
876 renames Instantiations."+";
kono
parents:
diff changeset
877
kono
parents:
diff changeset
878 ---------
kono
parents:
diff changeset
879 -- "-" --
kono
parents:
diff changeset
880 ---------
kono
parents:
diff changeset
881
kono
parents:
diff changeset
882 function "-"
kono
parents:
diff changeset
883 (Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
884 renames Instantiations."-";
kono
parents:
diff changeset
885
kono
parents:
diff changeset
886 function "-"
kono
parents:
diff changeset
887 (Left : Complex_Vector;
kono
parents:
diff changeset
888 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
889 renames Instantiations."-";
kono
parents:
diff changeset
890
kono
parents:
diff changeset
891 function "-"
kono
parents:
diff changeset
892 (Left : Real_Vector;
kono
parents:
diff changeset
893 Right : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
894 renames Instantiations."-";
kono
parents:
diff changeset
895
kono
parents:
diff changeset
896 function "-"
kono
parents:
diff changeset
897 (Left : Complex_Vector;
kono
parents:
diff changeset
898 Right : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
899 renames Instantiations."-";
kono
parents:
diff changeset
900
kono
parents:
diff changeset
901 function "-" (Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
902 renames Instantiations."-";
kono
parents:
diff changeset
903
kono
parents:
diff changeset
904 function "-"
kono
parents:
diff changeset
905 (Left : Complex_Matrix;
kono
parents:
diff changeset
906 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
907 renames Instantiations."-";
kono
parents:
diff changeset
908
kono
parents:
diff changeset
909 function "-"
kono
parents:
diff changeset
910 (Left : Real_Matrix;
kono
parents:
diff changeset
911 Right : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
912 renames Instantiations."-";
kono
parents:
diff changeset
913
kono
parents:
diff changeset
914 function "-"
kono
parents:
diff changeset
915 (Left : Complex_Matrix;
kono
parents:
diff changeset
916 Right : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
917 renames Instantiations."-";
kono
parents:
diff changeset
918
kono
parents:
diff changeset
919 ---------
kono
parents:
diff changeset
920 -- "/" --
kono
parents:
diff changeset
921 ---------
kono
parents:
diff changeset
922
kono
parents:
diff changeset
923 function "/"
kono
parents:
diff changeset
924 (Left : Complex_Vector;
kono
parents:
diff changeset
925 Right : Complex) return Complex_Vector
kono
parents:
diff changeset
926 renames Instantiations."/";
kono
parents:
diff changeset
927
kono
parents:
diff changeset
928 function "/"
kono
parents:
diff changeset
929 (Left : Complex_Vector;
kono
parents:
diff changeset
930 Right : Real'Base) return Complex_Vector
kono
parents:
diff changeset
931 renames Instantiations."/";
kono
parents:
diff changeset
932
kono
parents:
diff changeset
933 function "/"
kono
parents:
diff changeset
934 (Left : Complex_Matrix;
kono
parents:
diff changeset
935 Right : Complex) return Complex_Matrix
kono
parents:
diff changeset
936 renames Instantiations."/";
kono
parents:
diff changeset
937
kono
parents:
diff changeset
938 function "/"
kono
parents:
diff changeset
939 (Left : Complex_Matrix;
kono
parents:
diff changeset
940 Right : Real'Base) return Complex_Matrix
kono
parents:
diff changeset
941 renames Instantiations."/";
kono
parents:
diff changeset
942
kono
parents:
diff changeset
943 -----------
kono
parents:
diff changeset
944 -- "abs" --
kono
parents:
diff changeset
945 -----------
kono
parents:
diff changeset
946
kono
parents:
diff changeset
947 function "abs" (Right : Complex_Vector) return Real'Base
kono
parents:
diff changeset
948 renames Instantiations."abs";
kono
parents:
diff changeset
949
kono
parents:
diff changeset
950 --------------
kono
parents:
diff changeset
951 -- Argument --
kono
parents:
diff changeset
952 --------------
kono
parents:
diff changeset
953
kono
parents:
diff changeset
954 function Argument (X : Complex_Vector) return Real_Vector
kono
parents:
diff changeset
955 renames Instantiations.Argument;
kono
parents:
diff changeset
956
kono
parents:
diff changeset
957 function Argument
kono
parents:
diff changeset
958 (X : Complex_Vector;
kono
parents:
diff changeset
959 Cycle : Real'Base) return Real_Vector
kono
parents:
diff changeset
960 renames Instantiations.Argument;
kono
parents:
diff changeset
961
kono
parents:
diff changeset
962 function Argument (X : Complex_Matrix) return Real_Matrix
kono
parents:
diff changeset
963 renames Instantiations.Argument;
kono
parents:
diff changeset
964
kono
parents:
diff changeset
965 function Argument
kono
parents:
diff changeset
966 (X : Complex_Matrix;
kono
parents:
diff changeset
967 Cycle : Real'Base) return Real_Matrix
kono
parents:
diff changeset
968 renames Instantiations.Argument;
kono
parents:
diff changeset
969
kono
parents:
diff changeset
970 ----------------------------
kono
parents:
diff changeset
971 -- Compose_From_Cartesian --
kono
parents:
diff changeset
972 ----------------------------
kono
parents:
diff changeset
973
kono
parents:
diff changeset
974 function Compose_From_Cartesian (Re : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
975 renames Instantiations.Compose_From_Cartesian;
kono
parents:
diff changeset
976
kono
parents:
diff changeset
977 function Compose_From_Cartesian
kono
parents:
diff changeset
978 (Re : Real_Vector;
kono
parents:
diff changeset
979 Im : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
980 renames Instantiations.Compose_From_Cartesian;
kono
parents:
diff changeset
981
kono
parents:
diff changeset
982 function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
983 renames Instantiations.Compose_From_Cartesian;
kono
parents:
diff changeset
984
kono
parents:
diff changeset
985 function Compose_From_Cartesian
kono
parents:
diff changeset
986 (Re : Real_Matrix;
kono
parents:
diff changeset
987 Im : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
988 renames Instantiations.Compose_From_Cartesian;
kono
parents:
diff changeset
989
kono
parents:
diff changeset
990 ------------------------
kono
parents:
diff changeset
991 -- Compose_From_Polar --
kono
parents:
diff changeset
992 ------------------------
kono
parents:
diff changeset
993
kono
parents:
diff changeset
994 function Compose_From_Polar
kono
parents:
diff changeset
995 (Modulus : Real_Vector;
kono
parents:
diff changeset
996 Argument : Real_Vector) return Complex_Vector
kono
parents:
diff changeset
997 renames Instantiations.Compose_From_Polar;
kono
parents:
diff changeset
998
kono
parents:
diff changeset
999 function Compose_From_Polar
kono
parents:
diff changeset
1000 (Modulus : Real_Vector;
kono
parents:
diff changeset
1001 Argument : Real_Vector;
kono
parents:
diff changeset
1002 Cycle : Real'Base) return Complex_Vector
kono
parents:
diff changeset
1003 renames Instantiations.Compose_From_Polar;
kono
parents:
diff changeset
1004
kono
parents:
diff changeset
1005 function Compose_From_Polar
kono
parents:
diff changeset
1006 (Modulus : Real_Matrix;
kono
parents:
diff changeset
1007 Argument : Real_Matrix) return Complex_Matrix
kono
parents:
diff changeset
1008 renames Instantiations.Compose_From_Polar;
kono
parents:
diff changeset
1009
kono
parents:
diff changeset
1010 function Compose_From_Polar
kono
parents:
diff changeset
1011 (Modulus : Real_Matrix;
kono
parents:
diff changeset
1012 Argument : Real_Matrix;
kono
parents:
diff changeset
1013 Cycle : Real'Base) return Complex_Matrix
kono
parents:
diff changeset
1014 renames Instantiations.Compose_From_Polar;
kono
parents:
diff changeset
1015
kono
parents:
diff changeset
1016 ---------------
kono
parents:
diff changeset
1017 -- Conjugate --
kono
parents:
diff changeset
1018 ---------------
kono
parents:
diff changeset
1019
kono
parents:
diff changeset
1020 function Conjugate (X : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
1021 renames Instantiations.Conjugate;
kono
parents:
diff changeset
1022
kono
parents:
diff changeset
1023 function Conjugate (X : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
1024 renames Instantiations.Conjugate;
kono
parents:
diff changeset
1025
kono
parents:
diff changeset
1026 -----------------
kono
parents:
diff changeset
1027 -- Determinant --
kono
parents:
diff changeset
1028 -----------------
kono
parents:
diff changeset
1029
kono
parents:
diff changeset
1030 function Determinant (A : Complex_Matrix) return Complex is
kono
parents:
diff changeset
1031 M : Complex_Matrix := A;
kono
parents:
diff changeset
1032 B : Complex_Matrix (A'Range (1), 1 .. 0);
kono
parents:
diff changeset
1033 R : Complex;
kono
parents:
diff changeset
1034 begin
kono
parents:
diff changeset
1035 Forward_Eliminate (M, B, R);
kono
parents:
diff changeset
1036 return R;
kono
parents:
diff changeset
1037 end Determinant;
kono
parents:
diff changeset
1038
kono
parents:
diff changeset
1039 -----------------
kono
parents:
diff changeset
1040 -- Eigensystem --
kono
parents:
diff changeset
1041 -----------------
kono
parents:
diff changeset
1042
kono
parents:
diff changeset
1043 procedure Eigensystem
kono
parents:
diff changeset
1044 (A : Complex_Matrix;
kono
parents:
diff changeset
1045 Values : out Real_Vector;
kono
parents:
diff changeset
1046 Vectors : out Complex_Matrix)
kono
parents:
diff changeset
1047 is
kono
parents:
diff changeset
1048 N : constant Natural := Length (A);
kono
parents:
diff changeset
1049
kono
parents:
diff changeset
1050 -- For a Hermitian matrix C, we convert the eigenvalue problem to a
kono
parents:
diff changeset
1051 -- real symmetric one: if C = A + i * B, then the (N, N) complex
kono
parents:
diff changeset
1052 -- eigenvalue problem:
kono
parents:
diff changeset
1053 -- (A + i * B) * (u + i * v) = Lambda * (u + i * v)
kono
parents:
diff changeset
1054 --
kono
parents:
diff changeset
1055 -- is equivalent to the (2 * N, 2 * N) real eigenvalue problem:
kono
parents:
diff changeset
1056 -- [ A, B ] [ u ] = Lambda * [ u ]
kono
parents:
diff changeset
1057 -- [ -B, A ] [ v ] [ v ]
kono
parents:
diff changeset
1058 --
kono
parents:
diff changeset
1059 -- Note that the (2 * N, 2 * N) matrix above is symmetric, as
kono
parents:
diff changeset
1060 -- Transpose (A) = A and Transpose (B) = -B if C is Hermitian.
kono
parents:
diff changeset
1061
kono
parents:
diff changeset
1062 -- We solve this eigensystem using the real-valued algorithms. The final
kono
parents:
diff changeset
1063 -- result will have every eigenvalue twice, so in the sorted output we
kono
parents:
diff changeset
1064 -- just pick every second value, with associated eigenvector u + i * v.
kono
parents:
diff changeset
1065
kono
parents:
diff changeset
1066 M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
kono
parents:
diff changeset
1067 Vals : Real_Vector (1 .. 2 * N);
kono
parents:
diff changeset
1068 Vecs : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
kono
parents:
diff changeset
1069
kono
parents:
diff changeset
1070 begin
kono
parents:
diff changeset
1071 for J in 1 .. N loop
kono
parents:
diff changeset
1072 for K in 1 .. N loop
kono
parents:
diff changeset
1073 declare
kono
parents:
diff changeset
1074 C : constant Complex :=
kono
parents:
diff changeset
1075 (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
kono
parents:
diff changeset
1076 begin
kono
parents:
diff changeset
1077 M (J, K) := Re (C);
kono
parents:
diff changeset
1078 M (J + N, K + N) := Re (C);
kono
parents:
diff changeset
1079 M (J + N, K) := Im (C);
kono
parents:
diff changeset
1080 M (J, K + N) := -Im (C);
kono
parents:
diff changeset
1081 end;
kono
parents:
diff changeset
1082 end loop;
kono
parents:
diff changeset
1083 end loop;
kono
parents:
diff changeset
1084
kono
parents:
diff changeset
1085 Eigensystem (M, Vals, Vecs);
kono
parents:
diff changeset
1086
kono
parents:
diff changeset
1087 for J in 1 .. N loop
kono
parents:
diff changeset
1088 declare
kono
parents:
diff changeset
1089 Col : constant Integer := Values'First + (J - 1);
kono
parents:
diff changeset
1090 begin
kono
parents:
diff changeset
1091 Values (Col) := Vals (2 * J);
kono
parents:
diff changeset
1092
kono
parents:
diff changeset
1093 for K in 1 .. N loop
kono
parents:
diff changeset
1094 declare
kono
parents:
diff changeset
1095 Row : constant Integer := Vectors'First (2) + (K - 1);
kono
parents:
diff changeset
1096 begin
kono
parents:
diff changeset
1097 Vectors (Row, Col)
kono
parents:
diff changeset
1098 := (Vecs (J * 2, Col), Vecs (J * 2, Col + N));
kono
parents:
diff changeset
1099 end;
kono
parents:
diff changeset
1100 end loop;
kono
parents:
diff changeset
1101 end;
kono
parents:
diff changeset
1102 end loop;
kono
parents:
diff changeset
1103 end Eigensystem;
kono
parents:
diff changeset
1104
kono
parents:
diff changeset
1105 -----------------
kono
parents:
diff changeset
1106 -- Eigenvalues --
kono
parents:
diff changeset
1107 -----------------
kono
parents:
diff changeset
1108
kono
parents:
diff changeset
1109 function Eigenvalues (A : Complex_Matrix) return Real_Vector is
kono
parents:
diff changeset
1110 -- See Eigensystem for a description of the algorithm
kono
parents:
diff changeset
1111
kono
parents:
diff changeset
1112 N : constant Natural := Length (A);
kono
parents:
diff changeset
1113 R : Real_Vector (A'Range (1));
kono
parents:
diff changeset
1114
kono
parents:
diff changeset
1115 M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N);
kono
parents:
diff changeset
1116 Vals : Real_Vector (1 .. 2 * N);
kono
parents:
diff changeset
1117 begin
kono
parents:
diff changeset
1118 for J in 1 .. N loop
kono
parents:
diff changeset
1119 for K in 1 .. N loop
kono
parents:
diff changeset
1120 declare
kono
parents:
diff changeset
1121 C : constant Complex :=
kono
parents:
diff changeset
1122 (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
kono
parents:
diff changeset
1123 begin
kono
parents:
diff changeset
1124 M (J, K) := Re (C);
kono
parents:
diff changeset
1125 M (J + N, K + N) := Re (C);
kono
parents:
diff changeset
1126 M (J + N, K) := Im (C);
kono
parents:
diff changeset
1127 M (J, K + N) := -Im (C);
kono
parents:
diff changeset
1128 end;
kono
parents:
diff changeset
1129 end loop;
kono
parents:
diff changeset
1130 end loop;
kono
parents:
diff changeset
1131
kono
parents:
diff changeset
1132 Vals := Eigenvalues (M);
kono
parents:
diff changeset
1133
kono
parents:
diff changeset
1134 for J in 1 .. N loop
kono
parents:
diff changeset
1135 R (A'First (1) + (J - 1)) := Vals (2 * J);
kono
parents:
diff changeset
1136 end loop;
kono
parents:
diff changeset
1137
kono
parents:
diff changeset
1138 return R;
kono
parents:
diff changeset
1139 end Eigenvalues;
kono
parents:
diff changeset
1140
kono
parents:
diff changeset
1141 --------
kono
parents:
diff changeset
1142 -- Im --
kono
parents:
diff changeset
1143 --------
kono
parents:
diff changeset
1144
kono
parents:
diff changeset
1145 function Im (X : Complex_Vector) return Real_Vector
kono
parents:
diff changeset
1146 renames Instantiations.Im;
kono
parents:
diff changeset
1147
kono
parents:
diff changeset
1148 function Im (X : Complex_Matrix) return Real_Matrix
kono
parents:
diff changeset
1149 renames Instantiations.Im;
kono
parents:
diff changeset
1150
kono
parents:
diff changeset
1151 -------------
kono
parents:
diff changeset
1152 -- Inverse --
kono
parents:
diff changeset
1153 -------------
kono
parents:
diff changeset
1154
kono
parents:
diff changeset
1155 function Inverse (A : Complex_Matrix) return Complex_Matrix is
kono
parents:
diff changeset
1156 (Solve (A, Unit_Matrix (Length (A),
kono
parents:
diff changeset
1157 First_1 => A'First (2),
kono
parents:
diff changeset
1158 First_2 => A'First (1))));
kono
parents:
diff changeset
1159
kono
parents:
diff changeset
1160 -------------
kono
parents:
diff changeset
1161 -- Modulus --
kono
parents:
diff changeset
1162 -------------
kono
parents:
diff changeset
1163
kono
parents:
diff changeset
1164 function Modulus (X : Complex_Vector) return Real_Vector
kono
parents:
diff changeset
1165 renames Instantiations.Modulus;
kono
parents:
diff changeset
1166
kono
parents:
diff changeset
1167 function Modulus (X : Complex_Matrix) return Real_Matrix
kono
parents:
diff changeset
1168 renames Instantiations.Modulus;
kono
parents:
diff changeset
1169
kono
parents:
diff changeset
1170 --------
kono
parents:
diff changeset
1171 -- Re --
kono
parents:
diff changeset
1172 --------
kono
parents:
diff changeset
1173
kono
parents:
diff changeset
1174 function Re (X : Complex_Vector) return Real_Vector
kono
parents:
diff changeset
1175 renames Instantiations.Re;
kono
parents:
diff changeset
1176
kono
parents:
diff changeset
1177 function Re (X : Complex_Matrix) return Real_Matrix
kono
parents:
diff changeset
1178 renames Instantiations.Re;
kono
parents:
diff changeset
1179
kono
parents:
diff changeset
1180 ------------
kono
parents:
diff changeset
1181 -- Set_Im --
kono
parents:
diff changeset
1182 ------------
kono
parents:
diff changeset
1183
kono
parents:
diff changeset
1184 procedure Set_Im
kono
parents:
diff changeset
1185 (X : in out Complex_Matrix;
kono
parents:
diff changeset
1186 Im : Real_Matrix)
kono
parents:
diff changeset
1187 renames Instantiations.Set_Im;
kono
parents:
diff changeset
1188
kono
parents:
diff changeset
1189 procedure Set_Im
kono
parents:
diff changeset
1190 (X : in out Complex_Vector;
kono
parents:
diff changeset
1191 Im : Real_Vector)
kono
parents:
diff changeset
1192 renames Instantiations.Set_Im;
kono
parents:
diff changeset
1193
kono
parents:
diff changeset
1194 ------------
kono
parents:
diff changeset
1195 -- Set_Re --
kono
parents:
diff changeset
1196 ------------
kono
parents:
diff changeset
1197
kono
parents:
diff changeset
1198 procedure Set_Re
kono
parents:
diff changeset
1199 (X : in out Complex_Matrix;
kono
parents:
diff changeset
1200 Re : Real_Matrix)
kono
parents:
diff changeset
1201 renames Instantiations.Set_Re;
kono
parents:
diff changeset
1202
kono
parents:
diff changeset
1203 procedure Set_Re
kono
parents:
diff changeset
1204 (X : in out Complex_Vector;
kono
parents:
diff changeset
1205 Re : Real_Vector)
kono
parents:
diff changeset
1206 renames Instantiations.Set_Re;
kono
parents:
diff changeset
1207
kono
parents:
diff changeset
1208 -----------
kono
parents:
diff changeset
1209 -- Solve --
kono
parents:
diff changeset
1210 -----------
kono
parents:
diff changeset
1211
kono
parents:
diff changeset
1212 function Solve
kono
parents:
diff changeset
1213 (A : Complex_Matrix;
kono
parents:
diff changeset
1214 X : Complex_Vector) return Complex_Vector
kono
parents:
diff changeset
1215 renames Instantiations.Solve;
kono
parents:
diff changeset
1216
kono
parents:
diff changeset
1217 function Solve
kono
parents:
diff changeset
1218 (A : Complex_Matrix;
kono
parents:
diff changeset
1219 X : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
1220 renames Instantiations.Solve;
kono
parents:
diff changeset
1221
kono
parents:
diff changeset
1222 ---------------
kono
parents:
diff changeset
1223 -- Transpose --
kono
parents:
diff changeset
1224 ---------------
kono
parents:
diff changeset
1225
kono
parents:
diff changeset
1226 function Transpose
kono
parents:
diff changeset
1227 (X : Complex_Matrix) return Complex_Matrix
kono
parents:
diff changeset
1228 is
kono
parents:
diff changeset
1229 R : Complex_Matrix (X'Range (2), X'Range (1));
kono
parents:
diff changeset
1230 begin
kono
parents:
diff changeset
1231 Transpose (X, R);
kono
parents:
diff changeset
1232 return R;
kono
parents:
diff changeset
1233 end Transpose;
kono
parents:
diff changeset
1234
kono
parents:
diff changeset
1235 -----------------
kono
parents:
diff changeset
1236 -- Unit_Matrix --
kono
parents:
diff changeset
1237 -----------------
kono
parents:
diff changeset
1238
kono
parents:
diff changeset
1239 function Unit_Matrix
kono
parents:
diff changeset
1240 (Order : Positive;
kono
parents:
diff changeset
1241 First_1 : Integer := 1;
kono
parents:
diff changeset
1242 First_2 : Integer := 1) return Complex_Matrix
kono
parents:
diff changeset
1243 renames Instantiations.Unit_Matrix;
kono
parents:
diff changeset
1244
kono
parents:
diff changeset
1245 -----------------
kono
parents:
diff changeset
1246 -- Unit_Vector --
kono
parents:
diff changeset
1247 -----------------
kono
parents:
diff changeset
1248
kono
parents:
diff changeset
1249 function Unit_Vector
kono
parents:
diff changeset
1250 (Index : Integer;
kono
parents:
diff changeset
1251 Order : Positive;
kono
parents:
diff changeset
1252 First : Integer := 1) return Complex_Vector
kono
parents:
diff changeset
1253 renames Instantiations.Unit_Vector;
kono
parents:
diff changeset
1254
kono
parents:
diff changeset
1255 end Ada.Numerics.Generic_Complex_Arrays;