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