Return to ts_mreseva.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Continuation/ts_mreseva.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 Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
        !             4: with Multprec_Floating_Numbers_io;       use Multprec_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_to_Multprec_Convertors;    use Standard_to_Multprec_Convertors;
        !            10: with Multprec_Complex_Vectors;           use Multprec_Complex_Vectors;
        !            11: with Multprec_Complex_Vectors_io;        use Multprec_Complex_Vectors_io;
        !            12: with Multprec_Complex_Poly_Systems;      use Multprec_Complex_Poly_Systems;
        !            13: with Multprec_Complex_Poly_SysFun;       use Multprec_Complex_Poly_SysFun;
        !            14: with Multprec_Complex_Solutions;         use Multprec_Complex_Solutions;
        !            15: with Multprec_Complex_Solutions_io;      use Multprec_Complex_Solutions_io;
        !            16: with Multprec_Residual_Evaluations;      use Multprec_Residual_Evaluations;
        !            17:
        !            18: procedure ts_mreseva is
        !            19:
        !            20: -- DESCRIPTION : test on multi-precision residual computation.
        !            21:
        !            22:   procedure Test_Solution_Residuals
        !            23:               ( p : in Multprec_Complex_Poly_Systems.Poly_Sys ) is
        !            24:
        !            25:     outfile,solsfile : file_type;
        !            26:     p_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(p'range) := Create(p);
        !            27:     stsols : Standard_Complex_Solutions.Solution_List;
        !            28:     mpsols : Multprec_Complex_Solutions.Solution_List;
        !            29:
        !            30:   begin
        !            31:     new_line;
        !            32:     put_line("Reading the name of the output file.");
        !            33:     Read_Name_and_Create_File(outfile);
        !            34:     new_line;
        !            35:     put_line("Reading the name of the file with the solutions.");
        !            36:     Read_Name_and_Open_File(solsfile);
        !            37:     get(solsfile,stsols);
        !            38:     mpsols := Create(stsols);
        !            39:    -- get(solsfile,mpsols);
        !            40:     put_line(outfile,"The list of solutions : ");
        !            41:     put(outfile,mpsols);
        !            42:     Residuals(outfile,p_eval,mpsols);
        !            43:   end Test_Solution_Residuals;
        !            44:
        !            45:   procedure Interactive_Test_Residuals
        !            46:               ( p : in Multprec_Complex_Poly_Systems.Poly_Sys ) is
        !            47:
        !            48:     p_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(p'range) := Create(p);
        !            49:     root,eva : Vector(p'range);
        !            50:     res : Floating_Number;
        !            51:     ans : character;
        !            52:
        !            53:   begin
        !            54:     loop
        !            55:       new_line;
        !            56:       put("Give "); put(root'last,1);
        !            57:       put_line(" complex numbers for the root : ");
        !            58:       get(root);
        !            59:       eva := Eval(p_eval,root);
        !            60:       put_line("The evaluated root : "); put_line(eva);
        !            61:       res := Residual(p_eval,root);
        !            62:       put("The residual : "); put(res); new_line;
        !            63:       put("Do you want more tests ? (y/n) "); Ask_Yes_or_No(ans);
        !            64:       Clear(root); Clear(eva); Clear(res);
        !            65:       exit when (ans /= 'y');
        !            66:     end loop;
        !            67:   end Interactive_Test_Residuals;
        !            68:
        !            69:   procedure Main is
        !            70:
        !            71:     lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
        !            72:     ans : character;
        !            73:
        !            74:   begin
        !            75:     put_line("Choose one of the following : ");
        !            76:     put_line("  1. Evaluate user-given vectors");
        !            77:     put_line("  2. Residuals for a solution list.");
        !            78:     put("Type 1 or 2 to select : "); Ask_Alternative(ans,"12");
        !            79:     new_line;
        !            80:     get(lp);
        !            81:     declare
        !            82:       mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
        !            83:     begin
        !            84:       if ans = '1'
        !            85:        then Interactive_Test_Residuals(mp);
        !            86:        else Test_Solution_Residuals(mp);
        !            87:       end if;
        !            88:     end;
        !            89:   end Main;
        !            90:
        !            91: begin
        !            92:   new_line;
        !            93:   put_line("Test on the multi-precision residual computation.");
        !            94:   new_line;
        !            95:   Main;
        !            96: end ts_mreseva;