[BACK]Return to ts_rootrefi.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Continuation

Annotation of OpenXM_contrib/PHC/Ada/Continuation/ts_rootrefi.adb, Revision 1.1.1.1

1.1       maekawa     1: with text_io,integer_io;                 use text_io,integer_io;
                      2: with Communications_with_User;           use Communications_with_User;
                      3: with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
                      4: with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
                      5: with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
                      6: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
                      7: with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
                      8: with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
                      9: with Standard_Root_Refiners;             use Standard_Root_Refiners;
                     10: with Standard_to_Multprec_Convertors;    use Standard_to_Multprec_Convertors;
                     11: with Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
                     12: with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
                     13: with Multprec_Complex_Poly_Systems;      use Multprec_Complex_Poly_Systems;
                     14: with Multprec_Complex_Poly_SysFun;       use Multprec_Complex_Poly_SysFun;
                     15: with Multprec_Complex_Solutions;         use Multprec_Complex_Solutions;
                     16: with Multprec_Complex_Solutions_io;      use Multprec_Complex_Solutions_io;
                     17: with Multprec_Residual_Evaluations;      use Multprec_Residual_Evaluations;
                     18: with Multprec_Root_Refiners;             use Multprec_Root_Refiners;
                     19:
                     20: procedure ts_rootrefi is
                     21:
                     22: -- DESCRIPTION :
                     23: --   This routine facilitates interactive testing of the root refiners.
                     24:
                     25:   procedure Call_Standard_Root_Refiner
                     26:                ( file : in file_type;
                     27:                  p : in Standard_Complex_Poly_Systems.Poly_Sys;
                     28:                  sols : in out Standard_Complex_Solutions.Solution_List ) is
                     29:
                     30:     epsxa,epsfa,tolsing : double_float;
                     31:     numit : natural;
                     32:     max : constant natural := 5;
                     33:
                     34:   begin
                     35:     epsxa := 1.0E-14;
                     36:     epsfa := 1.0E-14;
                     37:     tolsing := 1.0E-08;
                     38:     Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
                     39:   end Call_Standard_Root_Refiner;
                     40:
                     41:   procedure Call_Multprec_Root_Refiner
                     42:                ( file : in file_type;
                     43:                  p : in Multprec_Complex_Poly_Systems.Poly_Sys;
                     44:                  sols : in out Multprec_Complex_Solutions.Solution_List ) is
                     45:
                     46:     epsxa,epsfa,tolsing : Floating_Number;
                     47:     numit,deci,size : natural;
                     48:     max : constant natural := 5;
                     49:
                     50:   begin
                     51:     put("Give the number of decimal places : "); get(deci);
                     52:     size := Decimal_to_Size(deci);
                     53:     put("The size of the numbers : "); put(size,1); new_line;
                     54:     Set_Size(sols,size);
                     55:     put("Give tolerance for error : "); get(epsxa);
                     56:     put("Give tolerance for residual : "); get(epsfa);
                     57:     tolsing := Create(1.0E-08);
                     58:     Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
                     59:   end Call_Multprec_Root_Refiner;
                     60:
                     61:   procedure Test_Standard_Root_Refiner is
                     62:
                     63:   -- DESCRIPTION :
                     64:   --   Test of root refining on list of solutions as standard vectors.
                     65:
                     66:     file : file_type;
                     67:     lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
                     68:     sols : Standard_Complex_Solutions.Solution_List;
                     69:
                     70:   begin
                     71:     new_line;
                     72:     put_line("Test on refining roots as standard complex vectors.");
                     73:     new_line;
                     74:     get(lp);
                     75:     put_line("The system : "); put(lp.all);
                     76:     new_line;
                     77:     put_line("Reading the name of the output file.");
                     78:     Read_Name_and_Create_File(file);
                     79:     put(file,lp'last,lp.all);
                     80:     new_line;
                     81:     Read(sols);
                     82:     new_line;
                     83:     new_line(file);
                     84:     put_line(file,"THE INITIAL SOLUTIONS : ");
                     85:     put(file,sols);
                     86:     Call_Standard_Root_Refiner(file,lp.all,sols);
                     87:   end Test_Standard_Root_Refiner;
                     88:
                     89:   procedure Test_Multprec_Root_Refiner is
                     90:
                     91:   -- DESCRIPTION :
                     92:   --   Test of root refining on list of solutions as standard vectors.
                     93:
                     94:     file : file_type;
                     95:     lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
                     96:     stsols : Standard_Complex_Solutions.Solution_List;
                     97:     mpsols : Multprec_Complex_Solutions.Solution_List;
                     98:
                     99:   begin
                    100:     new_line;
                    101:     put_line("Test on refining roots as multi-precision complex vectors.");
                    102:     new_line;
                    103:     get(lp);
                    104:     put_line("The system : "); put(lp.all);
                    105:     new_line;
                    106:     put_line("Reading the name of the output file.");
                    107:     Read_Name_and_Create_File(file);
                    108:     put(file,lp'last,lp.all);
                    109:     new_line;
                    110:    -- Read(stsols);
                    111:    -- new_line(file);
                    112:    -- put_line(file,"THE SOLUTION IN STANDARD PRECISION : ");
                    113:    -- put(file,stsols);
                    114:    -- mpsols := Create(stsols);
                    115:     Read(mpsols);
                    116:     new_line;
                    117:     new_line(file);
                    118:     put_line(file,"THE INITIAL SOLUTIONS : ");
                    119:     put(file,Length_Of(mpsols),lp'last,mpsols);
                    120:     declare
                    121:       mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
                    122:     begin
                    123:       Call_Multprec_Root_Refiner(file,mp,mpsols);
                    124:     end;
                    125:   end Test_Multprec_Root_Refiner;
                    126:
                    127:   procedure Test_Multprec_Residual_Evaluator is
                    128:
                    129:     file : file_type;
                    130:     lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
                    131:     mpsols : Multprec_Complex_Solutions.Solution_List;
                    132:
                    133:   begin
                    134:     new_line;
                    135:     put_line("Test on evaluating residuals with multi-precision arithmetic.");
                    136:     new_line;
                    137:     get(lp);
                    138:     put_line("The system : "); put(lp.all);
                    139:     new_line;
                    140:     put_line("Reading the name of the output file.");
                    141:     Read_Name_and_Create_File(file);
                    142:     put(file,lp'last,lp.all);
                    143:     new_line;
                    144:     Read(mpsols);
                    145:     new_line(file);
                    146:     put_line(file,"THE SOLUTIONS :");
                    147:     put(file,Length_Of(mpsols),lp'last,mpsols);
                    148:     declare
                    149:       mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
                    150:       mp_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(mp'range)
                    151:               := Create(mp);
                    152:       deci,size : natural;
                    153:     begin
                    154:       put("Give the number of decimal places : "); get(deci);
                    155:       size := Decimal_to_Size(deci);
                    156:       put("The size of the numbers : "); put(size,1); new_line;
                    157:       Set_Size(mpsols,size);
                    158:       put_line(file,"THE RESIDUALS :");
                    159:       Residuals(file,mp_eval,mpsols);
                    160:     end;
                    161:   end Test_Multprec_Residual_Evaluator;
                    162:
                    163:   procedure Main is
                    164:
                    165:     ans : character;
                    166:
                    167:   begin
                    168:     new_line;
                    169:     put_line("Interactive testing of root refiners.");
                    170:     new_line;
                    171:     put_line("Choose one of the following :                              ");
                    172:     put_line("  1. Test root refiner for standard complex numbers.       ");
                    173:     put_line("  2. Test root refiner for multi-precision complex numbers.");
                    174:     put_line("  3. Evaluate residuals with multi-precision arithmetic.");
                    175:     put("Type 0, 1, 2 or 3 to select : "); get(ans);
                    176:     case ans is
                    177:       when '1' => Test_Standard_Root_Refiner;
                    178:       when '2' => Test_Multprec_Root_Refiner;
                    179:       when '3' => Test_Multprec_Residual_Evaluator;
                    180:     end case;
                    181:   end Main;
                    182:
                    183: begin
                    184:   Main;
                    185: end ts_rootrefi;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>