Return to ts_rootrefi.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Continuation

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with text_io,integer_io;                 use text_io,integer_io;
with Communications_with_User;           use Communications_with_User;
with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
with Standard_Root_Refiners;             use Standard_Root_Refiners;
with Standard_to_Multprec_Convertors;    use Standard_to_Multprec_Convertors;
with Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
with Multprec_Complex_Poly_Systems;      use Multprec_Complex_Poly_Systems;
with Multprec_Complex_Poly_SysFun;       use Multprec_Complex_Poly_SysFun;
with Multprec_Complex_Solutions;         use Multprec_Complex_Solutions;
with Multprec_Complex_Solutions_io;      use Multprec_Complex_Solutions_io;
with Multprec_Residual_Evaluations;      use Multprec_Residual_Evaluations;
with Multprec_Root_Refiners;             use Multprec_Root_Refiners;

procedure ts_rootrefi is

-- DESCRIPTION :
--   This routine facilitates interactive testing of the root refiners.

  procedure Call_Standard_Root_Refiner
               ( file : in file_type;
                 p : in Standard_Complex_Poly_Systems.Poly_Sys;
                 sols : in out Standard_Complex_Solutions.Solution_List ) is

    epsxa,epsfa,tolsing : double_float;
    numit : natural;
    max : constant natural := 5;

  begin
    epsxa := 1.0E-14;
    epsfa := 1.0E-14;
    tolsing := 1.0E-08;
    Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
  end Call_Standard_Root_Refiner;

  procedure Call_Multprec_Root_Refiner
               ( file : in file_type;
                 p : in Multprec_Complex_Poly_Systems.Poly_Sys;
                 sols : in out Multprec_Complex_Solutions.Solution_List ) is

    epsxa,epsfa,tolsing : Floating_Number;
    numit,deci,size : natural;
    max : constant natural := 5;

  begin
    put("Give the number of decimal places : "); get(deci);
    size := Decimal_to_Size(deci);
    put("The size of the numbers : "); put(size,1); new_line;
    Set_Size(sols,size);
    put("Give tolerance for error : "); get(epsxa);
    put("Give tolerance for residual : "); get(epsfa);
    tolsing := Create(1.0E-08);
    Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
  end Call_Multprec_Root_Refiner;

  procedure Test_Standard_Root_Refiner is

  -- DESCRIPTION :
  --   Test of root refining on list of solutions as standard vectors.

    file : file_type;
    lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
    sols : Standard_Complex_Solutions.Solution_List;

  begin
    new_line;
    put_line("Test on refining roots as standard complex vectors.");
    new_line;
    get(lp);
    put_line("The system : "); put(lp.all);
    new_line;
    put_line("Reading the name of the output file.");
    Read_Name_and_Create_File(file);
    put(file,lp'last,lp.all);
    new_line;
    Read(sols);
    new_line;
    new_line(file);
    put_line(file,"THE INITIAL SOLUTIONS : ");
    put(file,sols);
    Call_Standard_Root_Refiner(file,lp.all,sols);
  end Test_Standard_Root_Refiner;

  procedure Test_Multprec_Root_Refiner is

  -- DESCRIPTION :
  --   Test of root refining on list of solutions as standard vectors.

    file : file_type;
    lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
    stsols : Standard_Complex_Solutions.Solution_List;
    mpsols : Multprec_Complex_Solutions.Solution_List;

  begin
    new_line;
    put_line("Test on refining roots as multi-precision complex vectors.");
    new_line;
    get(lp);
    put_line("The system : "); put(lp.all);
    new_line;
    put_line("Reading the name of the output file.");
    Read_Name_and_Create_File(file);
    put(file,lp'last,lp.all);
    new_line;
   -- Read(stsols);
   -- new_line(file);
   -- put_line(file,"THE SOLUTION IN STANDARD PRECISION : ");
   -- put(file,stsols);
   -- mpsols := Create(stsols);
    Read(mpsols);
    new_line;
    new_line(file);
    put_line(file,"THE INITIAL SOLUTIONS : ");
    put(file,Length_Of(mpsols),lp'last,mpsols);
    declare
      mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
    begin
      Call_Multprec_Root_Refiner(file,mp,mpsols);
    end;
  end Test_Multprec_Root_Refiner;

  procedure Test_Multprec_Residual_Evaluator is

    file : file_type;
    lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
    mpsols : Multprec_Complex_Solutions.Solution_List;

  begin
    new_line;
    put_line("Test on evaluating residuals with multi-precision arithmetic.");
    new_line;
    get(lp);
    put_line("The system : "); put(lp.all);
    new_line;
    put_line("Reading the name of the output file.");
    Read_Name_and_Create_File(file);
    put(file,lp'last,lp.all);
    new_line;
    Read(mpsols);
    new_line(file);
    put_line(file,"THE SOLUTIONS :");
    put(file,Length_Of(mpsols),lp'last,mpsols);
    declare
      mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
      mp_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(mp'range)
              := Create(mp);
      deci,size : natural;
    begin
      put("Give the number of decimal places : "); get(deci);
      size := Decimal_to_Size(deci);
      put("The size of the numbers : "); put(size,1); new_line;
      Set_Size(mpsols,size); 
      put_line(file,"THE RESIDUALS :");
      Residuals(file,mp_eval,mpsols);
    end;
  end Test_Multprec_Residual_Evaluator;

  procedure Main is

    ans : character;

  begin
    new_line;
    put_line("Interactive testing of root refiners.");
    new_line;
    put_line("Choose one of the following :                              ");
    put_line("  1. Test root refiner for standard complex numbers.       ");
    put_line("  2. Test root refiner for multi-precision complex numbers.");
    put_line("  3. Evaluate residuals with multi-precision arithmetic.");
    put("Type 0, 1, 2 or 3 to select : "); get(ans);
    case ans is
      when '1' => Test_Standard_Root_Refiner;
      when '2' => Test_Multprec_Root_Refiner;
      when '3' => Test_Multprec_Residual_Evaluator;
    end case;
  end Main;

begin
  Main;
end ts_rootrefi;