diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/a-ngcoar.adb')
| -rw-r--r-- | gcc-4.8/gcc/ada/a-ngcoar.adb | 1254 |
1 files changed, 0 insertions, 1254 deletions
diff --git a/gcc-4.8/gcc/ada/a-ngcoar.adb b/gcc-4.8/gcc/ada/a-ngcoar.adb deleted file mode 100644 index ca0c58c36..000000000 --- a/gcc-4.8/gcc/ada/a-ngcoar.adb +++ /dev/null @@ -1,1254 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- ADA.NUMERICS.GENERIC_COMPLEX_ARRAYS -- --- -- --- B o d y -- --- -- --- Copyright (C) 2006-2012, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with System.Generic_Array_Operations; use System.Generic_Array_Operations; -with Ada.Numerics; use Ada.Numerics; - -package body Ada.Numerics.Generic_Complex_Arrays is - - -- Operations that are defined in terms of operations on the type Real, - -- such as addition, subtraction and scaling, are computed in the canonical - -- way looping over all elements. - - package Ops renames System.Generic_Array_Operations; - - subtype Real is Real_Arrays.Real; - -- Work around visibility bug ??? - - function Is_Non_Zero (X : Complex) return Boolean is (X /= (0.0, 0.0)); - -- Needed by Back_Substitute - - procedure Back_Substitute is new Ops.Back_Substitute - (Scalar => Complex, - Matrix => Complex_Matrix, - Is_Non_Zero => Is_Non_Zero); - - procedure Forward_Eliminate is new Ops.Forward_Eliminate - (Scalar => Complex, - Real => Real'Base, - Matrix => Complex_Matrix, - Zero => (0.0, 0.0), - One => (1.0, 0.0)); - - procedure Transpose is new Ops.Transpose - (Scalar => Complex, - Matrix => Complex_Matrix); - - -- Helper function that raises a Constraint_Error is the argument is - -- not a square matrix, and otherwise returns its length. - - function Length is new Square_Matrix_Length (Complex, Complex_Matrix); - - -- Instant a generic square root implementation here, in order to avoid - -- instantiating a complete copy of Generic_Elementary_Functions. - -- Speed of the square root is not a big concern here. - - function Sqrt is new Ops.Sqrt (Real'Base); - - -- Instantiating the following subprograms directly would lead to - -- name clashes, so use a local package. - - package Instantiations is - - --------- - -- "*" -- - --------- - - function "*" is new Vector_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "*"); - - function "*" is new Vector_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "*"); - - function "*" is new Scalar_Vector_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "*"); - - function "*" is new Scalar_Vector_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "*"); - - function "*" is new Inner_Product - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Real_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Inner_Product - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Inner_Product - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Outer_Product - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Complex_Vector, - Matrix => Complex_Matrix); - - function "*" is new Outer_Product - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Complex_Vector, - Matrix => Complex_Matrix); - - function "*" is new Outer_Product - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Real_Vector, - Matrix => Complex_Matrix); - - function "*" is new Matrix_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "*"); - - function "*" is new Matrix_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "*"); - - function "*" is new Scalar_Matrix_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "*"); - - function "*" is new Scalar_Matrix_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "*"); - - function "*" is new Matrix_Vector_Product - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Matrix => Real_Matrix, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Matrix_Vector_Product - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Matrix => Complex_Matrix, - Right_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Matrix_Vector_Product - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Matrix => Complex_Matrix, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Vector_Matrix_Product - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Matrix => Complex_Matrix, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Vector_Matrix_Product - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Matrix => Real_Matrix, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Vector_Matrix_Product - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Matrix => Complex_Matrix, - Result_Vector => Complex_Vector, - Zero => (0.0, 0.0)); - - function "*" is new Matrix_Matrix_Product - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Zero => (0.0, 0.0)); - - function "*" is new Matrix_Matrix_Product - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Real_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Zero => (0.0, 0.0)); - - function "*" is new Matrix_Matrix_Product - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Zero => (0.0, 0.0)); - - --------- - -- "+" -- - --------- - - function "+" is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "+"); - - function "+" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "+"); - - function "+" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "+"); - - function "+" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => "+"); - - function "+" is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "+"); - - function "+" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "+"); - - function "+" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Real_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "+"); - - function "+" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "+"); - - --------- - -- "-" -- - --------- - - function "-" is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "-"); - - function "-" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "-"); - - function "-" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "-"); - - function "-" is new Vector_Vector_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Right_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => "-"); - - function "-" is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "-"); - - function "-" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "-"); - - function "-" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Real_Matrix, - Right_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "-"); - - function "-" is new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Right_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "-"); - - --------- - -- "/" -- - --------- - - function "/" is new Vector_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "/"); - - function "/" is new Vector_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => "/"); - - function "/" is new Matrix_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Complex, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "/"); - - function "/" is new Matrix_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => "/"); - - ----------- - -- "abs" -- - ----------- - - function "abs" is new L2_Norm - (X_Scalar => Complex, - Result_Real => Real'Base, - X_Vector => Complex_Vector); - - -------------- - -- Argument -- - -------------- - - function Argument is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Vector => Complex_Vector, - Result_Vector => Real_Vector, - Operation => Argument); - - function Argument is new Vector_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Real'Base, - Left_Vector => Complex_Vector, - Result_Vector => Real_Vector, - Operation => Argument); - - function Argument is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Result_Matrix => Real_Matrix, - Operation => Argument); - - function Argument is new Matrix_Scalar_Elementwise_Operation - (Left_Scalar => Complex, - Right_Scalar => Real'Base, - Result_Scalar => Real'Base, - Left_Matrix => Complex_Matrix, - Result_Matrix => Real_Matrix, - Operation => Argument); - - ---------------------------- - -- Compose_From_Cartesian -- - ---------------------------- - - function Compose_From_Cartesian is new Vector_Elementwise_Operation - (X_Scalar => Real'Base, - Result_Scalar => Complex, - X_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => Compose_From_Cartesian); - - function Compose_From_Cartesian is - new Vector_Vector_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => Compose_From_Cartesian); - - function Compose_From_Cartesian is new Matrix_Elementwise_Operation - (X_Scalar => Real'Base, - Result_Scalar => Complex, - X_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => Compose_From_Cartesian); - - function Compose_From_Cartesian is - new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Real_Matrix, - Right_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => Compose_From_Cartesian); - - ------------------------ - -- Compose_From_Polar -- - ------------------------ - - function Compose_From_Polar is - new Vector_Vector_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Vector => Real_Vector, - Right_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => Compose_From_Polar); - - function Compose_From_Polar is - new Vector_Vector_Scalar_Elementwise_Operation - (X_Scalar => Real'Base, - Y_Scalar => Real'Base, - Z_Scalar => Real'Base, - Result_Scalar => Complex, - X_Vector => Real_Vector, - Y_Vector => Real_Vector, - Result_Vector => Complex_Vector, - Operation => Compose_From_Polar); - - function Compose_From_Polar is - new Matrix_Matrix_Elementwise_Operation - (Left_Scalar => Real'Base, - Right_Scalar => Real'Base, - Result_Scalar => Complex, - Left_Matrix => Real_Matrix, - Right_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => Compose_From_Polar); - - function Compose_From_Polar is - new Matrix_Matrix_Scalar_Elementwise_Operation - (X_Scalar => Real'Base, - Y_Scalar => Real'Base, - Z_Scalar => Real'Base, - Result_Scalar => Complex, - X_Matrix => Real_Matrix, - Y_Matrix => Real_Matrix, - Result_Matrix => Complex_Matrix, - Operation => Compose_From_Polar); - - --------------- - -- Conjugate -- - --------------- - - function Conjugate is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Vector => Complex_Vector, - Result_Vector => Complex_Vector, - Operation => Conjugate); - - function Conjugate is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Complex, - X_Matrix => Complex_Matrix, - Result_Matrix => Complex_Matrix, - Operation => Conjugate); - - -------- - -- Im -- - -------- - - function Im is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Vector => Complex_Vector, - Result_Vector => Real_Vector, - Operation => Im); - - function Im is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Result_Matrix => Real_Matrix, - Operation => Im); - - ------------- - -- Modulus -- - ------------- - - function Modulus is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Vector => Complex_Vector, - Result_Vector => Real_Vector, - Operation => Modulus); - - function Modulus is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Result_Matrix => Real_Matrix, - Operation => Modulus); - - -------- - -- Re -- - -------- - - function Re is new Vector_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Vector => Complex_Vector, - Result_Vector => Real_Vector, - Operation => Re); - - function Re is new Matrix_Elementwise_Operation - (X_Scalar => Complex, - Result_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Result_Matrix => Real_Matrix, - Operation => Re); - - ------------ - -- Set_Im -- - ------------ - - procedure Set_Im is new Update_Vector_With_Vector - (X_Scalar => Complex, - Y_Scalar => Real'Base, - X_Vector => Complex_Vector, - Y_Vector => Real_Vector, - Update => Set_Im); - - procedure Set_Im is new Update_Matrix_With_Matrix - (X_Scalar => Complex, - Y_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Y_Matrix => Real_Matrix, - Update => Set_Im); - - ------------ - -- Set_Re -- - ------------ - - procedure Set_Re is new Update_Vector_With_Vector - (X_Scalar => Complex, - Y_Scalar => Real'Base, - X_Vector => Complex_Vector, - Y_Vector => Real_Vector, - Update => Set_Re); - - procedure Set_Re is new Update_Matrix_With_Matrix - (X_Scalar => Complex, - Y_Scalar => Real'Base, - X_Matrix => Complex_Matrix, - Y_Matrix => Real_Matrix, - Update => Set_Re); - - ----------- - -- Solve -- - ----------- - - function Solve is - new Matrix_Vector_Solution (Complex, Complex_Vector, Complex_Matrix); - - function Solve is - new Matrix_Matrix_Solution (Complex, Complex_Matrix); - - ----------------- - -- Unit_Matrix -- - ----------------- - - function Unit_Matrix is new System.Generic_Array_Operations.Unit_Matrix - (Scalar => Complex, - Matrix => Complex_Matrix, - Zero => (0.0, 0.0), - One => (1.0, 0.0)); - - function Unit_Vector is new System.Generic_Array_Operations.Unit_Vector - (Scalar => Complex, - Vector => Complex_Vector, - Zero => (0.0, 0.0), - One => (1.0, 0.0)); - end Instantiations; - - --------- - -- "*" -- - --------- - - function "*" - (Left : Complex_Vector; - Right : Complex_Vector) return Complex - renames Instantiations."*"; - - function "*" - (Left : Real_Vector; - Right : Complex_Vector) return Complex - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Real_Vector) return Complex - renames Instantiations."*"; - - function "*" - (Left : Complex; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Complex) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Real'Base; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Real'Base) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Complex_Vector) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Complex_Matrix) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Real_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Real_Matrix) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Real_Vector; - Right : Complex_Vector) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Real_Vector) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Real_Vector; - Right : Complex_Matrix) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Vector; - Right : Real_Matrix) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Real_Matrix; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Real_Vector) return Complex_Vector - renames Instantiations."*"; - - function "*" - (Left : Complex; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Complex) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Real'Base; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."*"; - - function "*" - (Left : Complex_Matrix; - Right : Real'Base) return Complex_Matrix - renames Instantiations."*"; - - --------- - -- "+" -- - --------- - - function "+" (Right : Complex_Vector) return Complex_Vector - renames Instantiations."+"; - - function "+" - (Left : Complex_Vector; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."+"; - - function "+" - (Left : Real_Vector; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."+"; - - function "+" - (Left : Complex_Vector; - Right : Real_Vector) return Complex_Vector - renames Instantiations."+"; - - function "+" (Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."+"; - - function "+" - (Left : Complex_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."+"; - - function "+" - (Left : Real_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."+"; - - function "+" - (Left : Complex_Matrix; - Right : Real_Matrix) return Complex_Matrix - renames Instantiations."+"; - - --------- - -- "-" -- - --------- - - function "-" - (Right : Complex_Vector) return Complex_Vector - renames Instantiations."-"; - - function "-" - (Left : Complex_Vector; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."-"; - - function "-" - (Left : Real_Vector; - Right : Complex_Vector) return Complex_Vector - renames Instantiations."-"; - - function "-" - (Left : Complex_Vector; - Right : Real_Vector) return Complex_Vector - renames Instantiations."-"; - - function "-" (Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."-"; - - function "-" - (Left : Complex_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."-"; - - function "-" - (Left : Real_Matrix; - Right : Complex_Matrix) return Complex_Matrix - renames Instantiations."-"; - - function "-" - (Left : Complex_Matrix; - Right : Real_Matrix) return Complex_Matrix - renames Instantiations."-"; - - --------- - -- "/" -- - --------- - - function "/" - (Left : Complex_Vector; - Right : Complex) return Complex_Vector - renames Instantiations."/"; - - function "/" - (Left : Complex_Vector; - Right : Real'Base) return Complex_Vector - renames Instantiations."/"; - - function "/" - (Left : Complex_Matrix; - Right : Complex) return Complex_Matrix - renames Instantiations."/"; - - function "/" - (Left : Complex_Matrix; - Right : Real'Base) return Complex_Matrix - renames Instantiations."/"; - - ----------- - -- "abs" -- - ----------- - - function "abs" (Right : Complex_Vector) return Real'Base - renames Instantiations."abs"; - - -------------- - -- Argument -- - -------------- - - function Argument (X : Complex_Vector) return Real_Vector - renames Instantiations.Argument; - - function Argument - (X : Complex_Vector; - Cycle : Real'Base) return Real_Vector - renames Instantiations.Argument; - - function Argument (X : Complex_Matrix) return Real_Matrix - renames Instantiations.Argument; - - function Argument - (X : Complex_Matrix; - Cycle : Real'Base) return Real_Matrix - renames Instantiations.Argument; - - ---------------------------- - -- Compose_From_Cartesian -- - ---------------------------- - - function Compose_From_Cartesian (Re : Real_Vector) return Complex_Vector - renames Instantiations.Compose_From_Cartesian; - - function Compose_From_Cartesian - (Re : Real_Vector; - Im : Real_Vector) return Complex_Vector - renames Instantiations.Compose_From_Cartesian; - - function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix - renames Instantiations.Compose_From_Cartesian; - - function Compose_From_Cartesian - (Re : Real_Matrix; - Im : Real_Matrix) return Complex_Matrix - renames Instantiations.Compose_From_Cartesian; - - ------------------------ - -- Compose_From_Polar -- - ------------------------ - - function Compose_From_Polar - (Modulus : Real_Vector; - Argument : Real_Vector) return Complex_Vector - renames Instantiations.Compose_From_Polar; - - function Compose_From_Polar - (Modulus : Real_Vector; - Argument : Real_Vector; - Cycle : Real'Base) return Complex_Vector - renames Instantiations.Compose_From_Polar; - - function Compose_From_Polar - (Modulus : Real_Matrix; - Argument : Real_Matrix) return Complex_Matrix - renames Instantiations.Compose_From_Polar; - - function Compose_From_Polar - (Modulus : Real_Matrix; - Argument : Real_Matrix; - Cycle : Real'Base) return Complex_Matrix - renames Instantiations.Compose_From_Polar; - - --------------- - -- Conjugate -- - --------------- - - function Conjugate (X : Complex_Vector) return Complex_Vector - renames Instantiations.Conjugate; - - function Conjugate (X : Complex_Matrix) return Complex_Matrix - renames Instantiations.Conjugate; - - ----------------- - -- Determinant -- - ----------------- - - function Determinant (A : Complex_Matrix) return Complex is - M : Complex_Matrix := A; - B : Complex_Matrix (A'Range (1), 1 .. 0); - R : Complex; - begin - Forward_Eliminate (M, B, R); - return R; - end Determinant; - - ----------------- - -- Eigensystem -- - ----------------- - - procedure Eigensystem - (A : Complex_Matrix; - Values : out Real_Vector; - Vectors : out Complex_Matrix) - is - N : constant Natural := Length (A); - - -- For a Hermitian matrix C, we convert the eigenvalue problem to a - -- real symmetric one: if C = A + i * B, then the (N, N) complex - -- eigenvalue problem: - -- (A + i * B) * (u + i * v) = Lambda * (u + i * v) - -- - -- is equivalent to the (2 * N, 2 * N) real eigenvalue problem: - -- [ A, B ] [ u ] = Lambda * [ u ] - -- [ -B, A ] [ v ] [ v ] - -- - -- Note that the (2 * N, 2 * N) matrix above is symmetric, as - -- Transpose (A) = A and Transpose (B) = -B if C is Hermitian. - - -- We solve this eigensystem using the real-valued algorithms. The final - -- result will have every eigenvalue twice, so in the sorted output we - -- just pick every second value, with associated eigenvector u + i * v. - - M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); - Vals : Real_Vector (1 .. 2 * N); - Vecs : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); - - begin - for J in 1 .. N loop - for K in 1 .. N loop - declare - C : constant Complex := - (A (A'First (1) + (J - 1), A'First (2) + (K - 1))); - begin - M (J, K) := Re (C); - M (J + N, K + N) := Re (C); - M (J + N, K) := Im (C); - M (J, K + N) := -Im (C); - end; - end loop; - end loop; - - Eigensystem (M, Vals, Vecs); - - for J in 1 .. N loop - declare - Col : constant Integer := Values'First + (J - 1); - begin - Values (Col) := Vals (2 * J); - - for K in 1 .. N loop - declare - Row : constant Integer := Vectors'First (2) + (K - 1); - begin - Vectors (Row, Col) - := (Vecs (J * 2, Col), Vecs (J * 2, Col + N)); - end; - end loop; - end; - end loop; - end Eigensystem; - - ----------------- - -- Eigenvalues -- - ----------------- - - function Eigenvalues (A : Complex_Matrix) return Real_Vector is - -- See Eigensystem for a description of the algorithm - - N : constant Natural := Length (A); - R : Real_Vector (A'Range (1)); - - M : Real_Matrix (1 .. 2 * N, 1 .. 2 * N); - Vals : Real_Vector (1 .. 2 * N); - begin - for J in 1 .. N loop - for K in 1 .. N loop - declare - C : constant Complex := - (A (A'First (1) + (J - 1), A'First (2) + (K - 1))); - begin - M (J, K) := Re (C); - M (J + N, K + N) := Re (C); - M (J + N, K) := Im (C); - M (J, K + N) := -Im (C); - end; - end loop; - end loop; - - Vals := Eigenvalues (M); - - for J in 1 .. N loop - R (A'First (1) + (J - 1)) := Vals (2 * J); - end loop; - - return R; - end Eigenvalues; - - -------- - -- Im -- - -------- - - function Im (X : Complex_Vector) return Real_Vector - renames Instantiations.Im; - - function Im (X : Complex_Matrix) return Real_Matrix - renames Instantiations.Im; - - ------------- - -- Inverse -- - ------------- - - function Inverse (A : Complex_Matrix) return Complex_Matrix is - (Solve (A, Unit_Matrix (Length (A)))); - - ------------- - -- Modulus -- - ------------- - - function Modulus (X : Complex_Vector) return Real_Vector - renames Instantiations.Modulus; - - function Modulus (X : Complex_Matrix) return Real_Matrix - renames Instantiations.Modulus; - - -------- - -- Re -- - -------- - - function Re (X : Complex_Vector) return Real_Vector - renames Instantiations.Re; - - function Re (X : Complex_Matrix) return Real_Matrix - renames Instantiations.Re; - - ------------ - -- Set_Im -- - ------------ - - procedure Set_Im - (X : in out Complex_Matrix; - Im : Real_Matrix) - renames Instantiations.Set_Im; - - procedure Set_Im - (X : in out Complex_Vector; - Im : Real_Vector) - renames Instantiations.Set_Im; - - ------------ - -- Set_Re -- - ------------ - - procedure Set_Re - (X : in out Complex_Matrix; - Re : Real_Matrix) - renames Instantiations.Set_Re; - - procedure Set_Re - (X : in out Complex_Vector; - Re : Real_Vector) - renames Instantiations.Set_Re; - - ----------- - -- Solve -- - ----------- - - function Solve - (A : Complex_Matrix; - X : Complex_Vector) return Complex_Vector - renames Instantiations.Solve; - - function Solve - (A : Complex_Matrix; - X : Complex_Matrix) return Complex_Matrix - renames Instantiations.Solve; - - --------------- - -- Transpose -- - --------------- - - function Transpose - (X : Complex_Matrix) return Complex_Matrix - is - R : Complex_Matrix (X'Range (2), X'Range (1)); - begin - Transpose (X, R); - return R; - end Transpose; - - ----------------- - -- Unit_Matrix -- - ----------------- - - function Unit_Matrix - (Order : Positive; - First_1 : Integer := 1; - First_2 : Integer := 1) return Complex_Matrix - renames Instantiations.Unit_Matrix; - - ----------------- - -- Unit_Vector -- - ----------------- - - function Unit_Vector - (Index : Integer; - Order : Positive; - First : Integer := 1) return Complex_Vector - renames Instantiations.Unit_Vector; - -end Ada.Numerics.Generic_Complex_Arrays; |