Commit 8668ea36 by Geert Bosch Committed by Arnaud Charlet

s-gearop.ads (Forward_Eliminate): Add "abs" formal function returning a Real.

2011-10-13  Geert Bosch  <bosch@adacore.com>

	* s-gearop.ads (Forward_Eliminate): Add "abs" formal function
	returning a Real.
	* s-gearop.adb (Forward_Eliminate): Remove local "abs" function
	and use formal.
	* a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
	new profile.

From-SVN: r179910
parent edcf5983
2011-10-13 Geert Bosch <bosch@adacore.com> 2011-10-13 Geert Bosch <bosch@adacore.com>
* s-gearop.ads (Forward_Eliminate): Add "abs" formal function
returning a Real.
* s-gearop.adb (Forward_Eliminate): Remove local "abs" function
and use formal.
* a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
new profile.
2011-10-13 Geert Bosch <bosch@adacore.com>
* a-ngrear.adb, s-gearop.adb, s-gearop.ads (Sqrt): Make generic and * a-ngrear.adb, s-gearop.adb, s-gearop.ads (Sqrt): Make generic and
move to System.Generic_Array_Operations. move to System.Generic_Array_Operations.
......
...@@ -33,7 +33,7 @@ ...@@ -33,7 +33,7 @@
-- reason for this is new Ada 2012 requirements that prohibit algorithms such -- reason for this is new Ada 2012 requirements that prohibit algorithms such
-- as Strassen's algorithm, which may be used by some BLAS implementations. In -- as Strassen's algorithm, which may be used by some BLAS implementations. In
-- addition, some platforms lacked suitable compilers to compile the reference -- addition, some platforms lacked suitable compilers to compile the reference
-- BLAS/LAPACK implementation. Finally, on many platforms there may be more -- BLAS/LAPACK implementation. Finally, on some platforms there are be more
-- floating point types than supported by BLAS/LAPACK. -- floating point types than supported by BLAS/LAPACK.
with Ada.Containers.Generic_Anonymous_Array_Sort; use Ada.Containers; with Ada.Containers.Generic_Anonymous_Array_Sort; use Ada.Containers;
...@@ -59,6 +59,7 @@ package body Ada.Numerics.Generic_Real_Arrays is ...@@ -59,6 +59,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
procedure Forward_Eliminate is new Ops.Forward_Eliminate procedure Forward_Eliminate is new Ops.Forward_Eliminate
(Scalar => Real'Base, (Scalar => Real'Base,
Real => Real'Base,
Matrix => Real_Matrix, Matrix => Real_Matrix,
Zero => 0.0, Zero => 0.0,
One => 1.0); One => 1.0);
......
...@@ -161,9 +161,6 @@ package body System.Generic_Array_Operations is ...@@ -161,9 +161,6 @@ package body System.Generic_Array_Operations is
pragma Assert (M'First (1) = N'First (1) and then pragma Assert (M'First (1) = N'First (1) and then
M'Last (1) = N'Last (1)); M'Last (1) = N'Last (1));
function "abs" (X : Scalar) return Scalar is
(if X < Zero then Zero - X else X);
-- The following are variations of the elementary matrix row operations: -- The following are variations of the elementary matrix row operations:
-- row switching, row multiplication and row addition. Because in this -- row switching, row multiplication and row addition. Because in this
-- algorithm the addition factor is always a negated value, we chose to -- algorithm the addition factor is always a negated value, we chose to
...@@ -274,14 +271,14 @@ package body System.Generic_Array_Operations is ...@@ -274,14 +271,14 @@ package body System.Generic_Array_Operations is
for J in M'Range (2) loop for J in M'Range (2) loop
declare declare
Max_Row : Integer := Row; Max_Row : Integer := Row;
Max_Abs : Scalar := Zero; Max_Abs : Real'Base := 0.0;
begin begin
-- Find best pivot in column J, starting in row Row -- Find best pivot in column J, starting in row Row
for K in Row .. M'Last (1) loop for K in Row .. M'Last (1) loop
declare declare
New_Abs : constant Scalar := abs M (K, J); New_Abs : constant Real'Base := abs M (K, J);
begin begin
if Max_Abs < New_Abs then if Max_Abs < New_Abs then
Max_Abs := New_Abs; Max_Abs := New_Abs;
...@@ -290,7 +287,7 @@ package body System.Generic_Array_Operations is ...@@ -290,7 +287,7 @@ package body System.Generic_Array_Operations is
end; end;
end loop; end loop;
if Zero < Max_Abs then if Max_Abs > 0.0 then
Switch_Row (M, N, Row, Max_Row); Switch_Row (M, N, Row, Max_Row);
Divide_Row (M, N, Row, M (Row, J)); Divide_Row (M, N, Row, M (Row, J));
......
...@@ -65,12 +65,14 @@ pragma Pure (Generic_Array_Operations); ...@@ -65,12 +65,14 @@ pragma Pure (Generic_Array_Operations);
generic generic
type Scalar is private; type Scalar is private;
type Real is digits <>;
type Matrix is array (Integer range <>, Integer range <>) of Scalar; type Matrix is array (Integer range <>, Integer range <>) of Scalar;
with function "abs" (Right : Scalar) return Real'Base is <>;
with function "-" (Left, Right : Scalar) return Scalar is <>; with function "-" (Left, Right : Scalar) return Scalar is <>;
with function "*" (Left, Right : Scalar) return Scalar is <>; with function "*" (Left, Right : Scalar) return Scalar is <>;
with function "/" (Left, Right : Scalar) return Scalar is <>; with function "/" (Left, Right : Scalar) return Scalar is <>;
with function "<" (Left, Right : Scalar) return Boolean is <>; Zero : Scalar;
Zero, One : Scalar; One : Scalar;
procedure Forward_Eliminate procedure Forward_Eliminate
(M : in out Matrix; (M : in out Matrix;
N : in out Matrix; N : in out Matrix;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment