File: [local] / OpenXM_contrib / PHC / Ada / Schubert / evaluated_minors.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:32 2000 UTC (23 years, 8 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with Standard_Natural_Vectors; use Standard_Natural_Vectors;
with Standard_Floating_Linear_Solvers; use Standard_Floating_Linear_Solvers;
with Standard_Complex_Linear_Solvers; use Standard_Complex_Linear_Solvers;
package body Evaluated_Minors is
function Determinant ( m : Standard_Floating_Matrices.Matrix )
return double_float is
res : double_float;
wrk : Standard_Floating_Matrices.Matrix(m'range(1),m'range(2));
piv : Standard_Natural_Vectors.Vector(m'range(1));
inf : natural;
begin
for i in m'range(1) loop
piv(i) := i;
for j in m'range(2) loop
wrk(i,j) := m(i,j);
end loop;
end loop;
lufac(wrk,m'last(1),piv,inf);
if inf /= 0
then res := 0.0;
else res := 1.0;
for i in m'range(1) loop
res := res*wrk(i,i);
end loop;
for i in piv'range loop
if piv(i) > i
then res := -res;
end if;
end loop;
end if;
return res;
end Determinant;
function Determinant ( m : Standard_Floating_Matrices.Matrix; b : Bracket )
return double_float is
res : double_float;
sqm : Standard_Floating_Matrices.Matrix(b'range,b'range);
piv : Standard_Natural_Vectors.Vector(b'range);
inf : natural;
begin
for i in b'range loop
piv(i) := i;
for j in b'range loop
sqm(i,j) := m(b(i),j);
end loop;
end loop;
lufac(sqm,b'last,piv,inf);
if inf /= 0
then res := 0.0;
else res := 1.0;
for i in b'range loop
res := res*sqm(i,i);
end loop;
for i in piv'range loop
if piv(i) > i
then res := -res;
end if;
end loop;
end if;
return res;
end Determinant;
function Determinant ( m : Standard_Complex_Matrices.Matrix )
return Complex_Number is
res : Complex_Number;
wrk : Standard_Complex_Matrices.Matrix(m'range(1),m'range(2));
piv : Standard_Natural_Vectors.Vector(m'range(1));
inf : natural;
begin
for i in m'range(1) loop
piv(i) := i;
for j in m'range(2) loop
wrk(i,j) := m(i,j);
end loop;
end loop;
lufac(wrk,wrk'last(1),piv,inf);
if inf /= 0
then res := Create(0.0);
else res := Create(1.0);
for i in wrk'range(1) loop
res := res*wrk(i,i);
end loop;
for i in piv'range loop
if piv(i) > i
then res := -res;
end if;
end loop;
end if;
return res;
end Determinant;
function Determinant ( m : Standard_Complex_Matrices.Matrix; b : Bracket )
return Complex_Number is
res : Complex_Number;
sqm : Standard_Complex_Matrices.Matrix(b'range,b'range);
piv : Standard_Natural_Vectors.Vector(b'range);
inf : natural;
begin
for i in b'range loop
piv(i) := i;
for j in b'range loop
sqm(i,j) := m(b(i),j);
end loop;
end loop;
lufac(sqm,b'last,piv,inf);
if inf /= 0
then res := Create(0.0);
else res := Create(1.0);
for i in sqm'range(1) loop
res := res*sqm(i,i);
end loop;
for i in piv'range loop
if piv(i) > i
then res := -res;
end if;
end loop;
end if;
return res;
end Determinant;
end Evaluated_Minors;