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>