Annotation of OpenXM_contrib/PHC/Ada/Main/dispatch.adb, Revision 1.1
1.1 ! maekawa 1: with text_io; use text_io;
! 2: with Unix_Command_Line;
! 3:
! 4: with mainscal,mainred;
! 5: with mainroco,bablroco;
! 6: with bablpoco,mainpoco;
! 7: with mainsmvc,babldmvc;
! 8: with mainphc,bablphc;
! 9: with mainvali,bablvali;
! 10: with mainenum;
! 11:
! 12: procedure Dispatch is
! 13:
! 14: -- BANNERS WITH INFORMATION TO START DIALOGUE WITH USER :
! 15:
! 16: welcome : constant string :=
! 17: "Welcome to PHC (Polynomial Homotopy Continuation) Version 2.0.";
! 18:
! 19: author : constant string :=
! 20: "Author is Jan Verschelde (E-mail: na.jverschelde@na-net.ornl.gov).";
! 21:
! 22: scalban : constant string :=
! 23: "Equation/variable Scaling on polynomial system and solution list.";
! 24:
! 25: reduban : constant string :=
! 26: "Linear and nonlinear Reduction w.r.t the total degree of the system.";
! 27:
! 28: rocoban : constant string :=
! 29: "Root counting and Construction of product and polyhedral start systems.";
! 30:
! 31: mvcban : constant string :=
! 32: "Mixed-Volume Computation by four different lifting strategies.";
! 33:
! 34: pocoban : constant string :=
! 35: "Polynomial Continuation defined by a homotopy in one parameter.";
! 36:
! 37: valiban : constant string :=
! 38: "Validation, refinement and purification of computed solution lists.";
! 39:
! 40: enumban : constant string :=
! 41: "SAGBI/Pieri homotopies to solve a problem in enumerative geometry.";
! 42:
! 43: -- AVAILABLE OPTIONS :
! 44:
! 45: options : constant string := "sdpmrvbe";
! 46: -- s : scal => scaling of a polynomial system
! 47: -- d : redu => reduction w.r.t. the total degree
! 48: -- p : poco => polynomial continuation
! 49: -- r : roco => root counting methods
! 50: -- m : mvc => mixed-volume computation
! 51: -- v : vali => validation of solutions
! 52: -- b : batch or black box processing
! 53: -- e : enum => numerical Schubert calculus
! 54:
! 55: option1,option2 : character;
! 56: posi : natural := 0;
! 57: argc : natural := Unix_Command_Line.Number_of_Arguments;
! 58:
! 59: -- UTILITIES FOR PROCESSING THE ARGUMENTS AND OPTIONS :
! 60:
! 61: function Read_Argument ( k : in natural ) return string is
! 62:
! 63: -- DESCRIPTION :
! 64: -- Reads the kth argument from the command line.
! 65: -- An argument is a string not proceeded by a `-' character.
! 66: -- The empty string is returned when there is no argument.
! 67:
! 68: null_string : constant string := "";
! 69: cnt : natural := 0;
! 70:
! 71: begin
! 72: if argc >= 1
! 73: then for i in 1..argc loop
! 74: declare
! 75: s : constant string := Unix_Command_Line.Argument(i);
! 76: begin
! 77: if s(1) /= '-'
! 78: then cnt := cnt + 1;
! 79: if k = cnt
! 80: then return s;
! 81: end if;
! 82: end if;
! 83: end;
! 84: end loop;
! 85: end if;
! 86: return null_string;
! 87: end Read_Argument;
! 88:
! 89: function Position ( c : character; s : string ) return natural is
! 90:
! 91: -- DESCRIPTION :
! 92: -- If the the string contains the character c, then its position
! 93: -- in the string will be returned. Otherwise s'first-1 will be returned.
! 94:
! 95: begin
! 96: for i in s'range loop
! 97: if s(i) = c
! 98: then return i;
! 99: end if;
! 100: end loop;
! 101: return s'first-1;
! 102: end Position;
! 103:
! 104: procedure Read_Next_Option ( pos : in out natural; legal : in string;
! 105: option : out character ) is
! 106:
! 107: -- DESCRIPTION :
! 108: -- Reads the next option from the command line arguments.
! 109:
! 110: -- ON ENTRY :
! 111: -- pos position in the command line of the last option
! 112: -- that has been read;
! 113: -- legal string which contains all legal options.
! 114:
! 115: -- ON RETURN :
! 116: -- pos the position in the command line of the last option read;
! 117: -- option is blank when no legal option could be read, otherwise it
! 118: -- contains the next legal option.
! 119:
! 120: res : character := ' ';
! 121: start : natural := pos+1;
! 122:
! 123: begin
! 124: if argc >= 1
! 125: then for i in start..argc loop
! 126: declare
! 127: s : constant string := Unix_Command_Line.Argument(i);
! 128: begin
! 129: if s(1) = '-'
! 130: then pos := Position(s(2),legal);
! 131: if pos >= legal'first
! 132: then res := legal(pos);
! 133: else put("The option `"); put(s);
! 134: put_line("' is not recognised. Will ignore it...");
! 135: end if;
! 136: end if;
! 137: end;
! 138: pos := i;
! 139: exit when (res /= ' ');
! 140: end loop;
! 141: end if;
! 142: option := res;
! 143: end Read_Next_Option;
! 144:
! 145: -- DISPATCHING ACCORDING TO OPTIONS :
! 146:
! 147: procedure Dispatcher ( infile,outfile : in string ) is
! 148: begin
! 149: case option1 is
! 150: when 'b' => Read_Next_Option(posi,options,option2);
! 151: case option2 is
! 152: when 's' => mainscal(infile,outfile);
! 153: when 'd' => mainred(infile,outfile);
! 154: when 'r' => bablroco(infile,outfile);
! 155: when 'm' => babldmvc(infile,outfile);
! 156: when 'p' => bablpoco(infile,outfile);
! 157: when 'v' => bablvali(infile,outfile);
! 158: when others => bablphc(infile,outfile);
! 159: end case;
! 160: when 's' => put_line(welcome); put_line(scalban);
! 161: mainscal(infile,outfile);
! 162: when 'd' => put_line(welcome); put_line(reduban);
! 163: mainred(infile,outfile);
! 164: when 'r' => Read_Next_Option(posi,options,option2);
! 165: case option2 is
! 166: when 'b' => bablroco(infile,outfile);
! 167: when others => put_line(welcome); put_line(rocoban);
! 168: mainroco(infile,outfile);
! 169: end case;
! 170: when 'm' => Read_Next_Option(posi,options,option2);
! 171: case option2 is
! 172: when 'b' => babldmvc(infile,outfile);
! 173: when others => put_line(welcome); put_line(mvcban);
! 174: mainsmvc(infile,outfile);
! 175: end case;
! 176: when 'p' => Read_Next_Option(posi,options,option2);
! 177: case option2 is
! 178: when 'b' => bablpoco(infile,outfile);
! 179: when others => put_line(welcome); put_line(pocoban);
! 180: mainpoco(infile,outfile);
! 181: end case;
! 182: when 'v' => Read_Next_Option(posi,options,option2);
! 183: case option2 is
! 184: when 'b' => bablvali(infile,outfile);
! 185: when others => put_line(welcome); put_line(valiban);
! 186: mainvali(infile,outfile);
! 187: end case;
! 188: when 'e' => put_line(welcome); put_line(enumban);
! 189: mainenum;
! 190: when others => put_line(welcome); mainphc(infile,outfile);
! 191: end case;
! 192: end Dispatcher;
! 193:
! 194: begin
! 195: Read_Next_Option(posi,options,option1);
! 196: declare
! 197: nullstring : constant string := "";
! 198: argument : constant string := Read_Argument(1);
! 199: outfile : constant string := Read_Argument(2);
! 200: begin
! 201: if (argument /= "") and then (argument = outfile)
! 202: then new_line;
! 203: put_line("Input and output file have the same name.");
! 204: put_line("Will ignore output file name...");
! 205: Dispatcher(argument,nullstring);
! 206: else Dispatcher(argument,outfile);
! 207: end if;
! 208: end;
! 209: end Dispatch;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dispatch.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Main