File: [local] / OpenXM_contrib / PHC / Ada / Homotopy / multprec_complex_solutions_io.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:23 2000 UTC (23 years, 11 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with integer_io; use integer_io;
with Communications_with_User; use Communications_with_User;
with Standard_Complex_Numbers;
with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
with Multprec_Complex_Numbers; use Multprec_Complex_Numbers;
with Multprec_Complex_Vectors; use Multprec_Complex_Vectors;
with Multprec_Complex_Numbers_io; use Multprec_Complex_Numbers_io;
with Multprec_Complex_Vectors_io; use Multprec_Complex_Vectors_io;
with Symbol_Table; use Symbol_Table;
package body Multprec_Complex_Solutions_io is
-- INPUT OF SYMBOL :
procedure skip_symbol ( file : in file_type ) is
-- DESCRIPTION :
-- Skips all symbols until a `:' is encountered.
c : character;
begin
loop
get(file,c);
exit when (c = ':');
end loop;
end skip_symbol;
function get_symbol ( file : in file_type ) return natural is
-- DESCRIPTION :
-- Reads a symbol from standard input and returns its number.
sb : Symbol;
c : character;
begin
for i in sb'range loop
sb(i) := ' ';
end loop;
loop -- skip the spaces
get(file,c);
exit when c /= ' ';
end loop;
sb(1) := c;
for i in 2..3 loop
get(file,c);
exit when c = ' ';
sb(i) := c;
end loop;
return Symbol_Table.get(sb);
end get_symbol;
-- OUTPUT OF A SYMBOL :
procedure put_symbol ( file : in file_type; i : in natural ) is
-- DESCRIPTION :
-- Given the number of the symbol,
-- the corresponding symbol will be written.
sb : Symbol := Get(i);
begin
for k in sb'range loop
exit when sb(k) = ' ';
put(file,sb(k));
end loop;
end put_symbol;
-- INPUT OF A SOLUTION VECTOR :
procedure get_vector ( s : in out Solution ) is
begin
get_vector(Standard_Input,s);
end get_vector;
procedure get_vector ( file : in file_type; s : in out Solution ) is
ind : natural;
begin
if Symbol_Table.Number < s.n
then for i in s.v'range loop
skip_symbol(file); get(file,s.v(i));
end loop;
else for i in s.v'range loop
ind := get_symbol(file); skip_symbol(file);
get(file,s.v(ind));
end loop;
end if;
end get_vector;
-- INPUT OF A SOLUTION :
procedure get ( s : out Solution ) is
begin
get(Standard_Input,s);
end get;
procedure get ( n : in natural; ls : out Link_to_Solution ) is
begin
get(Standard_Input,n,ls);
end get;
procedure get ( file : in file_type; s : out Solution ) is
c : character;
begin
get(file,c); get(file,c); get(file,c); get(file,c);
get(file,s.t); skip_line(file);
get(file,c); get(file,c); get(file,c); get(file,c); get(file,s.m);
if not End_of_Line(file)
then get(file,c); Skip_line(file); -- skip information on this line
end if;
get(file,c); skip_line(file);
get_vector(file,s);
end get;
procedure get ( file : in file_type;
n : in natural; ls : out Link_to_Solution ) is
s : Solution(n);
c : character;
begin
get(file,c); get(file,c); get(file,c); get(file,c);
get(file,s.t); skip_line(file);
get(file,c); get(file,c); get(file,c); get(file,c); get(file,s.m);
if not End_of_Line(file)
then get(file,c); Skip_line(file); -- skip information on this line
end if;
get(file,c); skip_line(file);
get_vector(file,s);
ls := new Solution'(s);
end get;
-- OUTPUT OF A SOLUTION VECTOR :
procedure put_vector ( s : in Solution ) is
begin
put_vector(Standard_Output,s);
end put_vector;
procedure put_vector ( file : in file_type; s : in Solution ) is
begin
if Symbol_Table.Number < s.n
then for i in s.v'range loop
put(file," x"); put(file,i,1); put(file," : ");
put(file,s.v(i)); new_line(file);
end loop;
else for i in s.v'range loop
put(file,' '); put_symbol(file,i); put(file," : ");
put(file,s.v(i)); new_line(file);
end loop;
end if;
end put_vector;
-- OUTPUT OF A SOLUTION :
procedure put ( s : in Solution ) is
begin
put(Standard_Output,s);
end put;
procedure put ( file : in file_type; s : in Solution ) is
begin
put(file,"t : "); put(file,s.t); new_line(file);
put(file,"m : "); put(file,s.m,1); new_line(file);
put_line(file,"the solution for t :");
put_vector(file,s);
put(file,"==");
put(file," err : "); put(file,s.err,2,3,3); put(file," =");
put(file," rco : "); put(file,s.rco,2,3,3); put(file," =");
put(file," res : "); put(file,s.res,2,3,3); put(file," =");
end put;
-- INPUT OF A LIST OF SOLUTIONS :
procedure get ( len,n : in natural;
sols,sols_last : in out Solution_List ) is
begin
get(Standard_Input,sols,sols_last);
end get;
procedure get ( len,n : in natural; sols : in out Solution_List ) is
begin
get(Standard_Input,len,n,sols);
end get;
procedure get ( sols,sols_last : in out Solution_List ) is
begin
get(Standard_Input,sols,sols_last);
end get;
procedure get ( sols : in out Solution_List ) is
begin
get(Standard_Input,sols);
end get;
procedure get ( file : in file_type; len,n : in natural;
sols,sols_last : in out Solution_List ) is
c : character;
begin
for i in 1..len loop
get(file,c); skip_line(file); -- skip opening bar
get(file,c); skip_line(file); -- skip line with solution number
declare
s : Solution(n);
begin
get(file,s);
Append(sols,sols_last,s);
end;
end loop;
get(file,c); skip_line(file); -- skip closing bar
end get;
procedure get ( file : in file_type; len,n : in natural;
sols : in out Solution_List ) is
sols_last : Solution_List;
begin
get(file,len,n,sols,sols_last);
end get;
procedure get ( file : in file_type;
sols,sols_last : in out Solution_List ) is
len,n : natural;
begin
get(file,len); get(file,n);
get(file,len,n,sols,sols_last);
end get;
procedure get ( file : in file_type; sols : in out Solution_List ) is
len,n : natural;
begin
get(file,len); get(file,n);
get(file,len,n,sols);
end get;
-- OUTPUT OF A LIST OF SOLUTIONS :
procedure put_bar ( file : in file_type ) is
begin
put_line(file,
"===========================================================");
end put_bar;
procedure put ( sols : in Solution_List ) is
begin
put(Standard_Output,sols);
end put;
procedure put ( len,n : in natural; sols : in Solution_List ) is
begin
put(Standard_Output,len,n,sols);
end put;
procedure put ( file : in file_type; sols : in Solution_List ) is
begin
if not Is_Null(sols)
then declare
count : natural := 1;
temp : Solution_List := sols;
begin
put_bar(file);
while not Is_Null(temp) loop
put(file,"solution "); put(file,count,1);
put(file," :"); new_line(file);
put(file,Head_Of(temp).all);
put_line(file,"="); -- instead of : put_bar(file);
temp := Tail_Of(temp);
count := count + 1;
end loop;
end;
end if;
end put;
procedure put ( file : in file_type; len,n : in natural;
sols : in Solution_List ) is
begin
put(file,len,1); put(file," "); put(file,n,1); new_line(file);
put(file,sols);
end put;
procedure Display_Format is
s : array(1..24) of string(1..65);
begin
s( 1):=" A solution list of a complex polynomial system is denoted by";
s( 2):="the number of solutions and the dimension, followed by a list of";
s( 3):="solutions. The solutions are separated by a banner line,";
s( 4):="followed by their position in the list. ";
s( 5):=" A solution consists of the current value of the continuation";
s( 6):="parameter t, its multiplicity (or winding number) m, and the";
s( 7):="solution vector. ";
s( 8):=" A solution vector contains as many lines as the dimension. The";
s( 9):="i-th line starts with the symbol that represents the i-th";
s(10):="unknown, followed by the colon `:' and two floating-point numbers";
s(11):="representing respectively the real and imaginary part of the";
s(12):="solution component. ";
s(13):=" As example we list the solution list of the regular solution";
s(14):="(1,i) of a 2-dimensional system in the unknowns x and y at t=1. ";
s(15):=" ";
s(16):="1 2 ";
s(17):="=================================================================";
s(18):="solution 1 : ";
s(19):="t : 1.00000000000000E+00 0.00000000000000E+00 ";
s(20):="m : 1 ";
s(21):="the solution for t : ";
s(22):=" x : 1.00000000000000E+00 0.00000000000000E+00 ";
s(23):=" y : 0.00000000000000E+00 1.00000000000000E+00 ";
s(24):="=================================================================";
for i in s'range loop
put_line(s(i));
end loop;
end Display_Format;
procedure Read ( sols : in out Solution_List ) is
file : file_type;
begin
put_line("Reading the name of the file for the solutions.");
Read_Name_and_Open_File(file);
get(file,sols);
Close(file);
exception
when others => Close(file); Clear(sols);
put_line("INCORRECT FORMAT OF SOLUTION LIST");
Display_Format; new_line;
Read(sols);
end Read;
end Multprec_Complex_Solutions_io;