Annotation of OpenXM_contrib/PHC/Ada/Homotopy/mainscal.adb, Revision 1.1
1.1 ! maekawa 1: with text_io,integer_io; use text_io,integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with File_Scanning; use File_Scanning;
! 4: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
! 5: with Standard_Complex_Vectors; use Standard_Complex_Vectors;
! 6: with Standard_Complex_Vectors_io; use Standard_Complex_Vectors_io;
! 7: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
! 8: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 9: with Standard_Complex_Solutions; use Standard_Complex_Solutions;
! 10: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 11: with Scaling;
! 12: with Drivers_for_Scaling; use Drivers_for_Scaling;
! 13:
! 14: procedure mainscal ( infilename,outfilename : in string ) is
! 15:
! 16: lp : Link_to_Poly_Sys;
! 17: infile : file_type;
! 18: outfile : file_type;
! 19: n,basis : natural;
! 20: scalvec : Link_to_Vector;
! 21: ans : character;
! 22: sysonfile : boolean;
! 23:
! 24: procedure Read_System ( file : in out file_type; filename : in string ) is
! 25: begin
! 26: if filename /= ""
! 27: then Open(file,in_file,filename);
! 28: new_line;
! 29: get(file,lp);
! 30: n := lp'length;
! 31: sysonfile := true;
! 32: else sysonfile := false;
! 33: end if;
! 34: exception
! 35: when others =>
! 36: new_line;
! 37: put("Could not open file with name "); put_line(filename);
! 38: sysonfile := false; lp := null; return;
! 39: end Read_System;
! 40:
! 41: procedure Separate_File ( p : in Poly_Sys ) is
! 42:
! 43: scafile : file_type;
! 44:
! 45: begin
! 46: new_line;
! 47: put("Do you want the scaled system on separate file ? (y/n) ");
! 48: Ask_Yes_or_No(ans);
! 49: if ans = 'y'
! 50: then put_line("Reading the name of the output file.");
! 51: Read_Name_and_Create_File(scafile);
! 52: put(scafile,lp.all);
! 53: if basis /= 0
! 54: then new_line(scafile);
! 55: put_line(scafile,"SCALING COEFFICIENTS :");
! 56: new_line(scafile);
! 57: put(scafile,basis,1); new_line(scafile);
! 58: put_line(scafile,scalvec);
! 59: end if;
! 60: Close(scafile);
! 61: end if;
! 62: end Separate_File;
! 63:
! 64: procedure Rescale is
! 65:
! 66: sols : Solution_List;
! 67: found : boolean;
! 68: m : natural;
! 69:
! 70: begin
! 71: if sysonfile -- scan for scaling coefficients
! 72: then Scan_and_Skip(infile,"SCALING COEFFICIENTS",found);
! 73: if found
! 74: then get(infile,basis);
! 75: scalvec := new vector(1..2*n);
! 76: get(infile,scalvec.all);
! 77: end if;
! 78: else found := false;
! 79: end if;
! 80: if not found
! 81: then put("Give the basis : "); get(basis);
! 82: put("Give "); put(2*n,1); put_line(" complex scaling numbers : ");
! 83: scalvec := new vector(1..2*n);
! 84: for i in scalvec'range loop
! 85: get(scalvec(i));
! 86: end loop;
! 87: end if;
! 88: if sysonfile -- scan for the solutions
! 89: then Reset(infile);
! 90: Scan_and_Skip(infile,"SOLUTIONS",found);
! 91: if found
! 92: then get(infile,sols);
! 93: end if;
! 94: Close(infile);
! 95: else found := false;
! 96: end if;
! 97: if not found
! 98: then put_line("Reading the name of the file for the solutions.");
! 99: Read_Name_and_Open_File(infile);
! 100: get(infile,sols);
! 101: Close(infile);
! 102: end if;
! 103: put_line(outfile,"THE SCALING COEFFICIENTS : ");
! 104: new_line(outfile);
! 105: put(outfile,basis,1); new_line(outfile);
! 106: put_line(outfile,scalvec);
! 107: new_line(outfile);
! 108: Scaling.Scale(basis,scalvec.all,sols);
! 109: m := Length_Of(sols);
! 110: if m > 0
! 111: then put_line(outfile,"THE DE-SCALED SOLUTIONS : ");
! 112: new_line(outfile);
! 113: put(outfile,m,Head_Of(sols).n,sols);
! 114: end if;
! 115: Close(outfile);
! 116: end Rescale;
! 117:
! 118: procedure Display_and_Dispatch_Menu
! 119: ( file : in file_type; p : in out Poly_Sys ) is
! 120:
! 121: -- DESCRIPTION :
! 122: -- Displays the menu and returns a choice, corresponding to one of the
! 123: -- three available scaling procedures.
! 124:
! 125: begin
! 126: loop
! 127: new_line;
! 128: put_line("MENU for Scaling Polynomial Systems :");
! 129: put_line(" 1 : Equation Scaling : divide by average coefficient ");
! 130: put_line(" 2 : Variable Scaling : change of variables, as z = (2^c)*x");
! 131: put_line(" 3 : Solution Scaling : back to original coordinates ");
! 132: put("Type 1, 2, or 3 to select scaling, or i for info : ");
! 133: Ask_Alternative(ans,"123i");
! 134: if ans = 'i'
! 135: then new_line; Drivers_for_Scaling.Display_Info; new_line;
! 136: end if;
! 137: exit when ans /= 'i';
! 138: end loop;
! 139: case ans is
! 140: when '1' => Equation_Scaling(file,p); basis := 0;
! 141: when '2' => Variable_Scaling(file,p,basis,scalvec);
! 142: when '3' => Rescale;
! 143: when others => null;
! 144: end case;
! 145: case ans is
! 146: when '1' | '2' => Write_Results(file,p,basis,scalvec);
! 147: when others => null;
! 148: end case;
! 149: if ans /= '3'
! 150: then Separate_File(p);
! 151: end if;
! 152: end Display_and_Dispatch_Menu;
! 153:
! 154: begin
! 155: Read_System(infile,infilename);
! 156: if lp = null
! 157: then loop
! 158: new_line;
! 159: put("Is the system on a file ? (y/n/i=info) ");
! 160: Ask_Alternative(ans,"yni");
! 161: if ans = 'i'
! 162: then new_line;
! 163: Standard_Complex_Poly_Systems_io.Display_Format;
! 164: new_line;
! 165: end if;
! 166: exit when ans /= 'i';
! 167: end loop;
! 168: new_line;
! 169: if ans = 'y'
! 170: then put_line("Reading the name of the input file.");
! 171: Read_Name_and_Open_File(infile);
! 172: get(infile,lp);
! 173: sysonfile := true;
! 174: n := lp'length;
! 175: else put("Give the dimension : "); get(n);
! 176: lp := new Poly_Sys(1..n);
! 177: put("Give "); put(n,1); put(" "); put(n,1);
! 178: put_line("-variate polynomials :");
! 179: get(n,lp.all);
! 180: skip_line; -- skip end_of_line symbol
! 181: sysonfile := false;
! 182: end if;
! 183: end if;
! 184: Create_Output_File(outfile,outfilename);
! 185: put(outfile,lp.all); new_line(outfile);
! 186: Display_and_Dispatch_Menu(outfile,lp.all);
! 187: end mainscal;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to mainscal.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