Annotation of OpenXM_contrib/PHC/Ada/Homotopy/standard_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_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>