[BACK]Return to evaluated_minors.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Schubert
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, 6 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;