Annotation of OpenXM_contrib/PHC/Ada/Homotopy/multprec_complex_solutions_io.adb, Revision 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