------------------------------------------------------------------------------
--                                                                          --
--                         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;