Annotation of OpenXM_contrib/PHC/Ada/Main/dispatch.adb, Revision 1.1.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