[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     ! 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>