Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Matrices/ts_cmpmat.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Standard_Natural_Vectors;
3: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
4: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
5: with Standard_Complex_Numbers;
6: with Standard_Complex_Vectors;
7: with Standard_Complex_Vectors_io;
8: with Standard_Complex_Matrices;
9: with Standard_Complex_Matrices_io;
10: with Standard_Complex_VecMats;
11: with Standard_Complex_VecMats_io;
12: with Standard_Complex_Linear_Solvers; use Standard_Complex_Linear_Solvers;
13: with Standard_Complex_Norms_Equals; use Standard_Complex_Norms_Equals;
14: with Standard_Random_Vectors; use Standard_Random_Vectors;
15: with Multprec_Random_Vectors; use Multprec_Random_Vectors;
16: with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
17: with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
18: with Multprec_Complex_Numbers;
19: with Multprec_Complex_Vectors;
20: with Multprec_Complex_Vectors_io;
21: with Multprec_Complex_Matrices;
22: with Multprec_Complex_Matrices_io;
23: with Multprec_Complex_Linear_Solvers; use Multprec_Complex_Linear_Solvers;
24: with Multprec_Complex_Norms_Equals; use Multprec_Complex_Norms_Equals;
25:
26: procedure ts_cmpmat is
27:
28: -- DESCRIPTION :
29: -- Tests the matrix packages of standard and multi-precision complex numbers.
30:
31: procedure Test_Standard_io is
32:
33: use Standard_Complex_Matrices,Standard_Complex_Matrices_io;
34:
35: n,m : natural;
36:
37: begin
38: put("Give the number of rows : "); get(n);
39: put("Give the number of columns : "); get(m);
40: declare
41: mat : Matrix(1..n,1..m);
42: begin
43: put("Give "); put(n,1); put("x"); put(m,1);
44: put_line(" complex matrix : "); get(mat);
45: put_line("Your matrix : "); put(mat); new_line;
46: end;
47: end Test_Standard_io;
48:
49: procedure Test_Standard_VecMat_io is
50:
51: use Standard_Complex_Matrices,Standard_Complex_Matrices_io;
52: use Standard_Complex_VecMats,Standard_Complex_VecMats_io;
53:
54: n,n1,n2 : natural;
55: lv : Link_to_VecMat;
56:
57: begin
58: put("Give the number of matrices : "); get(n);
59: put("Give #rows : "); get(n1);
60: put("Give #columns : "); get(n2);
61: put("Give "); put(n,1); put(" "); put(n1,1); put("-by-"); put(n2,1);
62: put_line(" integer matrices : ");
63: get(n,n1,n2,lv);
64: put_line("The vector of matrices :"); put(lv);
65: end Test_Standard_VecMat_io;
66:
67: procedure Test_Multprec_io is
68:
69: use Multprec_Complex_Matrices,Multprec_Complex_Matrices_io;
70:
71: n,m : natural;
72:
73: begin
74: put("Give the number of rows : "); get(n);
75: put("Give the number of columns : "); get(m);
76: declare
77: mat : Matrix(1..n,1..m);
78: begin
79: put("Give "); put(n,1); put("x"); put(m,1);
80: put_line(" complex matrix : "); get(mat);
81: put_line("Your matrix : "); put(mat); new_line;
82: end;
83: end Test_Multprec_io;
84:
85: function Vdm_Matrix ( v : Standard_Complex_Vectors.Vector )
86: return Standard_Complex_Matrices.Matrix is
87:
88: use Standard_Complex_Numbers;
89: use Standard_Complex_Matrices;
90:
91: n : constant natural := v'length;
92: res : Matrix(1..n,1..n);
93:
94: begin
95: for i in res'range(1) loop
96: for j in res'range(2) loop
97: res(i,j) := v(i)**(j-1);
98: end loop;
99: end loop;
100: return res;
101: end Vdm_Matrix;
102:
103: procedure lufac_Solve ( n : in natural;
104: mat : in Standard_Complex_Matrices.Matrix;
105: rhs : in Standard_Complex_Vectors.Vector ) is
106:
107: use Standard_Complex_Vectors;
108: use Standard_Complex_Vectors_io;
109: use Standard_Complex_Matrices;
110: use Standard_Complex_Matrices_io;
111:
112: wrk : Matrix(mat'range(1),mat'range(2));
113: piv : Standard_Natural_Vectors.Vector(mat'range(2));
114: info : natural;
115: res,sol,acc : Vector(rhs'range);
116: nrm : double_float;
117:
118: begin
119: put_line("Solving the linear system with lufac.");
120: wrk := mat;
121: lufac(wrk,n,piv,info);
122: put("info : "); put(info,1); new_line;
123: sol := rhs;
124: lusolve(wrk,n,piv,sol);
125: put_line("The solution vector :"); put(sol); new_line;
126: acc := mat*sol;
127: res := rhs - acc;
128: put_line("The residual : "); put(res); new_line;
129: nrm := Max_Norm(res);
130: put("Max norm of residual : "); put(nrm); new_line;
131: nrm := Sum_Norm(res);
132: put("Sum norm of residual : "); put(nrm); new_line;
133: end lufac_Solve;
134:
135: procedure lufco_Solve ( n : in natural;
136: mat : in Standard_Complex_Matrices.Matrix;
137: rhs : in Standard_Complex_Vectors.Vector ) is
138:
139: use Standard_Complex_Vectors;
140: use Standard_Complex_Vectors_io;
141: use Standard_Complex_Matrices;
142: use Standard_Complex_Matrices_io;
143:
144: wrk : Matrix(mat'range(1),mat'range(2)) := mat;
145: piv : Standard_Natural_Vectors.Vector(mat'range(2));
146: rcond,nrm : double_float;
147: res,sol : Vector(rhs'range);
148:
149: begin
150: put_line("Solving the linear system with lufco.");
151: lufco(wrk,n,piv,rcond);
152: put("inverse condition : "); put(rcond); new_line;
153: sol := rhs;
154: lusolve(wrk,n,piv,sol);
155: put_line("The solution vector :"); put(sol); new_line;
156: res := rhs - mat*sol;
157: put_line("The residual : "); put(res); new_line;
158: nrm := Max_Norm(res);
159: put("Max norm of residual : "); put(nrm); new_line;
160: nrm := Sum_Norm(res);
161: put("Sum norm of residual : "); put(nrm); new_line;
162: end lufco_Solve;
163:
164: procedure Random_Test_Standard_Linear_Solvers is
165:
166: use Standard_Complex_Vectors;
167: use Standard_Complex_Vectors_io;
168: use Standard_Complex_Matrices;
169: use Standard_Complex_Matrices_io;
170:
171: n,nb : natural;
172:
173: begin
174: new_line;
175: put_line("Testing of solving random standard linear systems.");
176: new_line;
177: put("Give the dimension : "); get(n);
178: put("Give the number of tests : "); get(nb);
179: for i in 1..nb loop
180: declare
181: mat : Matrix(1..n,1..n);
182: rhs : Vector(1..n);
183: begin
184: mat := Vdm_Matrix(Random_Vector(1,n));
185: rhs := Random_Vector(1,n);
186: lufac_Solve(n,mat,rhs);
187: lufco_Solve(n,mat,rhs);
188: end;
189: end loop;
190: end Random_Test_Standard_Linear_Solvers;
191:
192: function Vdm_Matrix ( v : Multprec_Complex_Vectors.Vector )
193: return Multprec_Complex_Matrices.Matrix is
194:
195: use Multprec_Complex_Numbers;
196: use Multprec_Complex_Matrices;
197:
198: n : constant natural := v'length;
199: res : Matrix(1..n,1..n);
200:
201: begin
202: for i in res'range(1) loop
203: for j in res'range(2) loop
204: res(i,j) := v(i)**(j-1);
205: end loop;
206: end loop;
207: return res;
208: end Vdm_Matrix;
209:
210: procedure lufac_Solve ( n : in natural;
211: mat : in Multprec_Complex_Matrices.Matrix;
212: rhs : in Multprec_Complex_Vectors.Vector ) is
213:
214: use Multprec_Complex_Vectors;
215: use Multprec_Complex_Vectors_io;
216: use Multprec_Complex_Matrices;
217: use Multprec_Complex_Matrices_io;
218:
219: wrk : Matrix(mat'range(1),mat'range(2)) := +mat;
220: piv : Standard_Natural_Vectors.Vector(mat'range(2));
221: info : natural;
222: res,sol,acc : Vector(rhs'range);
223: nrm : Floating_Number;
224:
225: begin
226: put_line("Solving the linear system with lufac.");
227: lufac(wrk,n,piv,info);
228: put("info : "); put(info,1); new_line;
229: sol := +rhs;
230: lusolve(wrk,n,piv,sol);
231: put_line("The solution vector :"); put(sol); new_line;
232: acc := mat*sol;
233: res := rhs - acc;
234: put_line("The residual : "); put(res); new_line;
235: nrm := Max_Norm(res);
236: put("Max norm of residual : "); put(nrm); new_line;
237: Clear(nrm);
238: nrm := Sum_Norm(res);
239: put("Sum norm of residual : "); put(nrm); new_line;
240: Clear(nrm);
241: Clear(wrk); Clear(acc); Clear(res); Clear(sol);
242: end lufac_Solve;
243:
244: procedure lufco_Solve ( n : in natural;
245: mat : in Multprec_Complex_Matrices.Matrix;
246: rhs : in Multprec_Complex_Vectors.Vector ) is
247:
248: use Multprec_Complex_Vectors;
249: use Multprec_Complex_Vectors_io;
250: use Multprec_Complex_Matrices;
251: use Multprec_Complex_Matrices_io;
252:
253: wrk : Matrix(mat'range(1),mat'range(2)) := +mat;
254: piv : Standard_Natural_Vectors.Vector(mat'range(2));
255: rcond,nrm : Floating_Number;
256: res,sol,acc : Vector(rhs'range);
257:
258: begin
259: put_line("Solving the linear system with lufco.");
260: lufco(wrk,n,piv,rcond);
261: put("inverse condition : "); put(rcond); new_line;
262: sol := +rhs;
263: lusolve(wrk,n,piv,sol);
264: put_line("The solution vector :"); put(sol); new_line;
265: acc := mat*sol;
266: res := rhs - acc;
267: put_line("The residual : "); put(res); new_line;
268: nrm := Max_Norm(res);
269: put("Max norm of residual : "); put(nrm); new_line;
270: Clear(nrm);
271: nrm := Sum_Norm(res);
272: put("Sum norm of residual : "); put(nrm); new_line;
273: Clear(wrk); Clear(acc); Clear(res); Clear(sol);
274: Clear(nrm); Clear(rcond);
275: end lufco_Solve;
276:
277: procedure Random_Test_Multprec_Linear_Solvers is
278:
279: use Multprec_Complex_Vectors;
280: use Multprec_Complex_Vectors_io;
281: use Multprec_Complex_Matrices;
282: use Multprec_Complex_Matrices_io;
283:
284: n,sz,nb : natural;
285:
286: begin
287: new_line;
288: put_line("Testing of solving random multi-precision linear systems.");
289: new_line;
290: put("Give the dimension : "); get(n);
291: put("Give the size of the numbers : "); get(sz);
292: put("Give the number of tests : "); get(nb);
293: for i in 1..nb loop
294: declare
295: rnd : Vector(1..n) := Random_Vector(1,n,sz);
296: mat : Matrix(1..n,1..n) := Vdm_Matrix(rnd);
297: rhs : Vector(1..n) := Random_Vector(1,n,sz);
298: begin
299: lufac_Solve(n,mat,rhs);
300: -- lufco_Solve(n,mat,rhs);
301: Clear(rnd); Clear(mat); Clear(rhs);
302: end;
303: end loop;
304: end Random_Test_Multprec_Linear_Solvers;
305:
306: procedure Main is
307:
308: ans : character;
309:
310: begin
311: new_line;
312: put_line("Interactive testing of matrices of complex numbers");
313: loop
314: new_line;
315: put_line("Choose one of the following : ");
316: put_line(" 0. exit this program. ");
317: put_line(" 1. io of matrices of standard complex numbers. ");
318: put_line(" 2. io of vectors of matrices of standard complex numbers. ");
319: put_line(" 3. test on solving random standard linear systems. ");
320: put_line(" 4. io of matrices of multi-precision complex numbers. ");
321: put_line(" 5. test on solving random multi-precision complex numbers.");
322: put("Make your choice (0,1,2,3,4 or 5) : "); get(ans);
323: exit when (ans = '0');
324: case ans is
325: when '1' => Test_Standard_io;
326: when '2' => Test_Standard_VecMat_io;
327: when '3' => Random_Test_Standard_Linear_Solvers;
328: when '4' => Test_Multprec_io;
329: when '5' => Random_Test_Multprec_Linear_Solvers;
330: when others => null;
331: end case;
332: end loop;
333: end Main;
334:
335: begin
336: Main;
337: end ts_cmpmat;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_cmpmat.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Matrices