Annotation of OpenXM_contrib/PHC/Ada/Homotopy/multprec_complex_solutions_io.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Communications_with_User; use Communications_with_User;
3: with Standard_Complex_Numbers;
4: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
5: with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
6: with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
7: with Multprec_Complex_Numbers; use Multprec_Complex_Numbers;
8: with Multprec_Complex_Vectors; use Multprec_Complex_Vectors;
9: with Multprec_Complex_Numbers_io; use Multprec_Complex_Numbers_io;
10: with Multprec_Complex_Vectors_io; use Multprec_Complex_Vectors_io;
11: with Symbol_Table; use Symbol_Table;
12:
13: package body Multprec_Complex_Solutions_io is
14:
15: -- INPUT OF SYMBOL :
16:
17: procedure skip_symbol ( file : in file_type ) is
18:
19: -- DESCRIPTION :
20: -- Skips all symbols until a `:' is encountered.
21:
22: c : character;
23:
24: begin
25: loop
26: get(file,c);
27: exit when (c = ':');
28: end loop;
29: end skip_symbol;
30:
31: function get_symbol ( file : in file_type ) return natural is
32:
33: -- DESCRIPTION :
34: -- Reads a symbol from standard input and returns its number.
35:
36: sb : Symbol;
37: c : character;
38:
39: begin
40: for i in sb'range loop
41: sb(i) := ' ';
42: end loop;
43: loop -- skip the spaces
44: get(file,c);
45: exit when c /= ' ';
46: end loop;
47: sb(1) := c;
48: for i in 2..3 loop
49: get(file,c);
50: exit when c = ' ';
51: sb(i) := c;
52: end loop;
53: return Symbol_Table.get(sb);
54: end get_symbol;
55:
56: -- OUTPUT OF A SYMBOL :
57:
58: procedure put_symbol ( file : in file_type; i : in natural ) is
59:
60: -- DESCRIPTION :
61: -- Given the number of the symbol,
62: -- the corresponding symbol will be written.
63:
64: sb : Symbol := Get(i);
65:
66: begin
67: for k in sb'range loop
68: exit when sb(k) = ' ';
69: put(file,sb(k));
70: end loop;
71: end put_symbol;
72:
73: -- INPUT OF A SOLUTION VECTOR :
74:
75: procedure get_vector ( s : in out Solution ) is
76: begin
77: get_vector(Standard_Input,s);
78: end get_vector;
79:
80: procedure get_vector ( file : in file_type; s : in out Solution ) is
81:
82: ind : natural;
83:
84: begin
85: if Symbol_Table.Number < s.n
86: then for i in s.v'range loop
87: skip_symbol(file); get(file,s.v(i));
88: end loop;
89: else for i in s.v'range loop
90: ind := get_symbol(file); skip_symbol(file);
91: get(file,s.v(ind));
92: end loop;
93: end if;
94: end get_vector;
95:
96: -- INPUT OF A SOLUTION :
97:
98: procedure get ( s : out Solution ) is
99: begin
100: get(Standard_Input,s);
101: end get;
102:
103: procedure get ( n : in natural; ls : out Link_to_Solution ) is
104: begin
105: get(Standard_Input,n,ls);
106: end get;
107:
108: procedure get ( file : in file_type; s : out Solution ) is
109:
110: c : character;
111:
112: begin
113: get(file,c); get(file,c); get(file,c); get(file,c);
114: get(file,s.t); skip_line(file);
115: get(file,c); get(file,c); get(file,c); get(file,c); get(file,s.m);
116: if not End_of_Line(file)
117: then get(file,c); Skip_line(file); -- skip information on this line
118: end if;
119: get(file,c); skip_line(file);
120: get_vector(file,s);
121: end get;
122:
123: procedure get ( file : in file_type;
124: n : in natural; ls : out Link_to_Solution ) is
125:
126: s : Solution(n);
127: c : character;
128:
129: begin
130: get(file,c); get(file,c); get(file,c); get(file,c);
131: get(file,s.t); skip_line(file);
132: get(file,c); get(file,c); get(file,c); get(file,c); get(file,s.m);
133: if not End_of_Line(file)
134: then get(file,c); Skip_line(file); -- skip information on this line
135: end if;
136: get(file,c); skip_line(file);
137: get_vector(file,s);
138: ls := new Solution'(s);
139: end get;
140:
141: -- OUTPUT OF A SOLUTION VECTOR :
142:
143: procedure put_vector ( s : in Solution ) is
144: begin
145: put_vector(Standard_Output,s);
146: end put_vector;
147:
148: procedure put_vector ( file : in file_type; s : in Solution ) is
149: begin
150: if Symbol_Table.Number < s.n
151: then for i in s.v'range loop
152: put(file," x"); put(file,i,1); put(file," : ");
153: put(file,s.v(i)); new_line(file);
154: end loop;
155: else for i in s.v'range loop
156: put(file,' '); put_symbol(file,i); put(file," : ");
157: put(file,s.v(i)); new_line(file);
158: end loop;
159: end if;
160: end put_vector;
161:
162: -- OUTPUT OF A SOLUTION :
163:
164: procedure put ( s : in Solution ) is
165: begin
166: put(Standard_Output,s);
167: end put;
168:
169: procedure put ( file : in file_type; s : in Solution ) is
170: begin
171: put(file,"t : "); put(file,s.t); new_line(file);
172: put(file,"m : "); put(file,s.m,1); new_line(file);
173: put_line(file,"the solution for t :");
174: put_vector(file,s);
175: put(file,"==");
176: put(file," err : "); put(file,s.err,2,3,3); put(file," =");
177: put(file," rco : "); put(file,s.rco,2,3,3); put(file," =");
178: put(file," res : "); put(file,s.res,2,3,3); put(file," =");
179: end put;
180:
181: -- INPUT OF A LIST OF SOLUTIONS :
182:
183: procedure get ( len,n : in natural;
184: sols,sols_last : in out Solution_List ) is
185: begin
186: get(Standard_Input,sols,sols_last);
187: end get;
188:
189: procedure get ( len,n : in natural; sols : in out Solution_List ) is
190: begin
191: get(Standard_Input,len,n,sols);
192: end get;
193:
194: procedure get ( sols,sols_last : in out Solution_List ) is
195: begin
196: get(Standard_Input,sols,sols_last);
197: end get;
198:
199: procedure get ( sols : in out Solution_List ) is
200: begin
201: get(Standard_Input,sols);
202: end get;
203:
204: procedure get ( file : in file_type; len,n : in natural;
205: sols,sols_last : in out Solution_List ) is
206:
207: c : character;
208:
209: begin
210: for i in 1..len loop
211: get(file,c); skip_line(file); -- skip opening bar
212: get(file,c); skip_line(file); -- skip line with solution number
213: declare
214: s : Solution(n);
215: begin
216: get(file,s);
217: Append(sols,sols_last,s);
218: end;
219: end loop;
220: get(file,c); skip_line(file); -- skip closing bar
221: end get;
222:
223: procedure get ( file : in file_type; len,n : in natural;
224: sols : in out Solution_List ) is
225:
226: sols_last : Solution_List;
227:
228: begin
229: get(file,len,n,sols,sols_last);
230: end get;
231:
232: procedure get ( file : in file_type;
233: sols,sols_last : in out Solution_List ) is
234:
235: len,n : natural;
236:
237: begin
238: get(file,len); get(file,n);
239: get(file,len,n,sols,sols_last);
240: end get;
241:
242: procedure get ( file : in file_type; sols : in out Solution_List ) is
243:
244: len,n : natural;
245:
246: begin
247: get(file,len); get(file,n);
248: get(file,len,n,sols);
249: end get;
250:
251: -- OUTPUT OF A LIST OF SOLUTIONS :
252:
253: procedure put_bar ( file : in file_type ) is
254: begin
255: put_line(file,
256: "===========================================================");
257: end put_bar;
258:
259: procedure put ( sols : in Solution_List ) is
260: begin
261: put(Standard_Output,sols);
262: end put;
263:
264: procedure put ( len,n : in natural; sols : in Solution_List ) is
265: begin
266: put(Standard_Output,len,n,sols);
267: end put;
268:
269: procedure put ( file : in file_type; sols : in Solution_List ) is
270: begin
271: if not Is_Null(sols)
272: then declare
273: count : natural := 1;
274: temp : Solution_List := sols;
275: begin
276: put_bar(file);
277: while not Is_Null(temp) loop
278: put(file,"solution "); put(file,count,1);
279: put(file," :"); new_line(file);
280: put(file,Head_Of(temp).all);
281: put_line(file,"="); -- instead of : put_bar(file);
282: temp := Tail_Of(temp);
283: count := count + 1;
284: end loop;
285: end;
286: end if;
287: end put;
288:
289: procedure put ( file : in file_type; len,n : in natural;
290: sols : in Solution_List ) is
291: begin
292: put(file,len,1); put(file," "); put(file,n,1); new_line(file);
293: put(file,sols);
294: end put;
295:
296: procedure Display_Format is
297:
298: s : array(1..24) of string(1..65);
299:
300: begin
301: s( 1):=" A solution list of a complex polynomial system is denoted by";
302: s( 2):="the number of solutions and the dimension, followed by a list of";
303: s( 3):="solutions. The solutions are separated by a banner line,";
304: s( 4):="followed by their position in the list. ";
305: s( 5):=" A solution consists of the current value of the continuation";
306: s( 6):="parameter t, its multiplicity (or winding number) m, and the";
307: s( 7):="solution vector. ";
308: s( 8):=" A solution vector contains as many lines as the dimension. The";
309: s( 9):="i-th line starts with the symbol that represents the i-th";
310: s(10):="unknown, followed by the colon `:' and two floating-point numbers";
311: s(11):="representing respectively the real and imaginary part of the";
312: s(12):="solution component. ";
313: s(13):=" As example we list the solution list of the regular solution";
314: s(14):="(1,i) of a 2-dimensional system in the unknowns x and y at t=1. ";
315: s(15):=" ";
316: s(16):="1 2 ";
317: s(17):="=================================================================";
318: s(18):="solution 1 : ";
319: s(19):="t : 1.00000000000000E+00 0.00000000000000E+00 ";
320: s(20):="m : 1 ";
321: s(21):="the solution for t : ";
322: s(22):=" x : 1.00000000000000E+00 0.00000000000000E+00 ";
323: s(23):=" y : 0.00000000000000E+00 1.00000000000000E+00 ";
324: s(24):="=================================================================";
325: for i in s'range loop
326: put_line(s(i));
327: end loop;
328: end Display_Format;
329:
330: procedure Read ( sols : in out Solution_List ) is
331:
332: file : file_type;
333:
334: begin
335: put_line("Reading the name of the file for the solutions.");
336: Read_Name_and_Open_File(file);
337: get(file,sols);
338: Close(file);
339: exception
340: when others => Close(file); Clear(sols);
341: put_line("INCORRECT FORMAT OF SOLUTION LIST");
342: Display_Format; new_line;
343: Read(sols);
344: end Read;
345:
346: end Multprec_Complex_Solutions_io;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to multprec_complex_solutions_io.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Homotopy