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