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