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