Annotation of OpenXM_contrib/PHC/Ada/Continuation/ts_rootrefi.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 Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 4: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
! 5: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
! 6: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 7: with Standard_Complex_Solutions; use Standard_Complex_Solutions;
! 8: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 9: with Standard_Root_Refiners; use Standard_Root_Refiners;
! 10: with Standard_to_Multprec_Convertors; use Standard_to_Multprec_Convertors;
! 11: with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
! 12: with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
! 13: with Multprec_Complex_Poly_Systems; use Multprec_Complex_Poly_Systems;
! 14: with Multprec_Complex_Poly_SysFun; use Multprec_Complex_Poly_SysFun;
! 15: with Multprec_Complex_Solutions; use Multprec_Complex_Solutions;
! 16: with Multprec_Complex_Solutions_io; use Multprec_Complex_Solutions_io;
! 17: with Multprec_Residual_Evaluations; use Multprec_Residual_Evaluations;
! 18: with Multprec_Root_Refiners; use Multprec_Root_Refiners;
! 19:
! 20: procedure ts_rootrefi is
! 21:
! 22: -- DESCRIPTION :
! 23: -- This routine facilitates interactive testing of the root refiners.
! 24:
! 25: procedure Call_Standard_Root_Refiner
! 26: ( file : in file_type;
! 27: p : in Standard_Complex_Poly_Systems.Poly_Sys;
! 28: sols : in out Standard_Complex_Solutions.Solution_List ) is
! 29:
! 30: epsxa,epsfa,tolsing : double_float;
! 31: numit : natural;
! 32: max : constant natural := 5;
! 33:
! 34: begin
! 35: epsxa := 1.0E-14;
! 36: epsfa := 1.0E-14;
! 37: tolsing := 1.0E-08;
! 38: Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
! 39: end Call_Standard_Root_Refiner;
! 40:
! 41: procedure Call_Multprec_Root_Refiner
! 42: ( file : in file_type;
! 43: p : in Multprec_Complex_Poly_Systems.Poly_Sys;
! 44: sols : in out Multprec_Complex_Solutions.Solution_List ) is
! 45:
! 46: epsxa,epsfa,tolsing : Floating_Number;
! 47: numit,deci,size : natural;
! 48: max : constant natural := 5;
! 49:
! 50: begin
! 51: put("Give the number of decimal places : "); get(deci);
! 52: size := Decimal_to_Size(deci);
! 53: put("The size of the numbers : "); put(size,1); new_line;
! 54: Set_Size(sols,size);
! 55: put("Give tolerance for error : "); get(epsxa);
! 56: put("Give tolerance for residual : "); get(epsfa);
! 57: tolsing := Create(1.0E-08);
! 58: Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,true);
! 59: end Call_Multprec_Root_Refiner;
! 60:
! 61: procedure Test_Standard_Root_Refiner is
! 62:
! 63: -- DESCRIPTION :
! 64: -- Test of root refining on list of solutions as standard vectors.
! 65:
! 66: file : file_type;
! 67: lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
! 68: sols : Standard_Complex_Solutions.Solution_List;
! 69:
! 70: begin
! 71: new_line;
! 72: put_line("Test on refining roots as standard complex vectors.");
! 73: new_line;
! 74: get(lp);
! 75: put_line("The system : "); put(lp.all);
! 76: new_line;
! 77: put_line("Reading the name of the output file.");
! 78: Read_Name_and_Create_File(file);
! 79: put(file,lp'last,lp.all);
! 80: new_line;
! 81: Read(sols);
! 82: new_line;
! 83: new_line(file);
! 84: put_line(file,"THE INITIAL SOLUTIONS : ");
! 85: put(file,sols);
! 86: Call_Standard_Root_Refiner(file,lp.all,sols);
! 87: end Test_Standard_Root_Refiner;
! 88:
! 89: procedure Test_Multprec_Root_Refiner is
! 90:
! 91: -- DESCRIPTION :
! 92: -- Test of root refining on list of solutions as standard vectors.
! 93:
! 94: file : file_type;
! 95: lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
! 96: stsols : Standard_Complex_Solutions.Solution_List;
! 97: mpsols : Multprec_Complex_Solutions.Solution_List;
! 98:
! 99: begin
! 100: new_line;
! 101: put_line("Test on refining roots as multi-precision complex vectors.");
! 102: new_line;
! 103: get(lp);
! 104: put_line("The system : "); put(lp.all);
! 105: new_line;
! 106: put_line("Reading the name of the output file.");
! 107: Read_Name_and_Create_File(file);
! 108: put(file,lp'last,lp.all);
! 109: new_line;
! 110: -- Read(stsols);
! 111: -- new_line(file);
! 112: -- put_line(file,"THE SOLUTION IN STANDARD PRECISION : ");
! 113: -- put(file,stsols);
! 114: -- mpsols := Create(stsols);
! 115: Read(mpsols);
! 116: new_line;
! 117: new_line(file);
! 118: put_line(file,"THE INITIAL SOLUTIONS : ");
! 119: put(file,Length_Of(mpsols),lp'last,mpsols);
! 120: declare
! 121: mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
! 122: begin
! 123: Call_Multprec_Root_Refiner(file,mp,mpsols);
! 124: end;
! 125: end Test_Multprec_Root_Refiner;
! 126:
! 127: procedure Test_Multprec_Residual_Evaluator is
! 128:
! 129: file : file_type;
! 130: lp : Standard_Complex_Poly_Systems.Link_to_Poly_Sys;
! 131: mpsols : Multprec_Complex_Solutions.Solution_List;
! 132:
! 133: begin
! 134: new_line;
! 135: put_line("Test on evaluating residuals with multi-precision arithmetic.");
! 136: new_line;
! 137: get(lp);
! 138: put_line("The system : "); put(lp.all);
! 139: new_line;
! 140: put_line("Reading the name of the output file.");
! 141: Read_Name_and_Create_File(file);
! 142: put(file,lp'last,lp.all);
! 143: new_line;
! 144: Read(mpsols);
! 145: new_line(file);
! 146: put_line(file,"THE SOLUTIONS :");
! 147: put(file,Length_Of(mpsols),lp'last,mpsols);
! 148: declare
! 149: mp : Multprec_Complex_Poly_Systems.Poly_Sys(lp'range) := Convert(lp.all);
! 150: mp_eval : Multprec_Complex_Poly_SysFun.Eval_Poly_Sys(mp'range)
! 151: := Create(mp);
! 152: deci,size : natural;
! 153: begin
! 154: put("Give the number of decimal places : "); get(deci);
! 155: size := Decimal_to_Size(deci);
! 156: put("The size of the numbers : "); put(size,1); new_line;
! 157: Set_Size(mpsols,size);
! 158: put_line(file,"THE RESIDUALS :");
! 159: Residuals(file,mp_eval,mpsols);
! 160: end;
! 161: end Test_Multprec_Residual_Evaluator;
! 162:
! 163: procedure Main is
! 164:
! 165: ans : character;
! 166:
! 167: begin
! 168: new_line;
! 169: put_line("Interactive testing of root refiners.");
! 170: new_line;
! 171: put_line("Choose one of the following : ");
! 172: put_line(" 1. Test root refiner for standard complex numbers. ");
! 173: put_line(" 2. Test root refiner for multi-precision complex numbers.");
! 174: put_line(" 3. Evaluate residuals with multi-precision arithmetic.");
! 175: put("Type 0, 1, 2 or 3 to select : "); get(ans);
! 176: case ans is
! 177: when '1' => Test_Standard_Root_Refiner;
! 178: when '2' => Test_Multprec_Root_Refiner;
! 179: when '3' => Test_Multprec_Residual_Evaluator;
! 180: end case;
! 181: end Main;
! 182:
! 183: begin
! 184: Main;
! 185: end ts_rootrefi;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>